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Containers  (individually  identified)  were  lightered  to  and  from  ship  and 
shore  by  LCUs,  LCM8s,  LARC-LXs,  LARC-XVs,  LACV-30S,  and  causeway  ferries. 
Shoreslde  container  transfer  facilities  included  a  300- ton  crane  on  a  jetty, 
a  140-ton  amphibian  discharge  crane,  an  elevated  causeway  system,  lightweight 
amphibious  container  handler,  and  a  DeLong  pier  system.  Transfer  operations 
between  lighters,  cranes,  materials  handling  equipment,  and  tractor-trailers 
were  Identified  by  Individual  craft  and  timed  for  both  container  off-load  and 
retrograde  operations.  The  final  destination  for  containers  was  an  Inland 
marshaling  yard  where  arrival /departure  and  off-load/load  events  were  record* 

Operations  were  divided  Into  four  distinct  phases  with  each  phase  con¬ 
sisting  of  off-load  and  retrograde  periods,  and  having  varying  units  and 
equipment.  Phase  I  was  an  Army  bare  beach,  quick  reaction,  non-mobilization 
scenario.  Phase  II  simulated  the  activities  Involving  a  Navy-Marine  Corps 
off-load  of  an  assault  follow-on  echelon  (AFOE).  Phase  III  was  a  joint 
operation  under  mobilization  conditions  and  involved  Improved  beach  facilltle: 
Phase  IV  (also  referred  to  as  Phase  I (R) )  Involved  a  one-day  repeat  of  Phase 
I  in  order  to  assess  the  effects  of  more  experienced  crews. 

The  report  mentions  voids  in  the  data  base  and  the  effects  of  timing 
and  accuracy  of  results  when  analyzing  brief  events  of  only  1-2  min.  or  less. 
The  report  cautions  that  future  users  of  the  Joint  LOTS  Data  Base  should 
Incorporate  error  checking  routines  In  any  analyses  programs  In  order  to 
correct  and/or  discard  data  Inconsistencies. 

The  programs  described  In  this  report  were  used  In  the  analyses  of  the 
Joint  LOTS  test  final  report  (ORI,  Inc.  TR  1412).  The  programs  and  the  data 
base  were  copied  to  magnetic  tape  and  sent  to  the  Joint  Test  Director  at 
Ft.  Eustls  for  retention  by  the  Commandant,  US  Amy  Transportation  School. 
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I .  INTRODUCTION 


BACKGROUND 

Described  in  this  report  are  the  Loglstics-Over-the-Shore  (LOTS) 
data  reduction  programs  that  were  developed  for  the  Director,  Defense  Test 
and  Evaluation,  ODDR&E,  OSD  under  modification  number  9  to  Contract  No. 
MDA-903-75-C-0016 . 

REPORT  ORGANIZATION 

Each  data  reduction  program  Is  described  in  a  separate  chapter  of 
this  report.  Each  chapter  begins  with  an  introduction  which  states  what  the 
program  computes  and  gives  a  sample  output.  Then  an  overview  Is  given  on 
f  how  the  program  is  designed.  Included  In  this  section  for  each  multi-step 

program  Is  a  flow  chart  of  tyie  related  steps.  Following  this  Is  a  description 
of  the  System  2000  data  management  system  retrieval  programs.  Finally, 
structure  diagram,  flow  chart  and  description  of  each  main  program,  and  sub¬ 
routine  and  function  for  data  base  reduction  Is  presented. 

Contained  in  each  Appendix  is  a  listing  of  the  System  2000  retrieval 
statements,  control  statements  needed  to  execute  the  program,  and  a  listing 
of  the  program. 

PROGRAM  USES 

Consistency  Check  Program 

The  outputs  from  this  program  flag  Invalid  container  Identification 
numbers  by  comparison  with  a  control  list;  Indicate  a  "no  match"  whenever 
there  Is  an  Inconsistency  In  the  data  relating  to  a  container  transfer  from 
ship  to  lighter,  lighter  to  beach  facility  and  beach  facility  to  truck,  and 
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finally  from  truck  to  a  storage  location  in  the  marshaling  yard.  The  consis¬ 
tency  check  program  does  not  check  every  data  entry,  but  rather  only  those 
described  above.  The  results  of  this  program  were  used  to  make  corrections 
to  the  data  base  whenever  the  data  could  be  verified  by  reference  to  data 
collection  sheets.  Corrections  were  possible  in  most  cases.  After  the 
corrections  were  applied,  the  consistency  check  program  was  rerun  and  a 
substantial  reduction  In  Invalid  cargo  identifiers  and  "no  matches"  was  noted. 

Lighter  Cycle  Times  Program 

This  program  traces  each  lighter  carrying  containers  between  ship 
and  shore  facilities.  It  computes  the  time  the  lighter  spent  at  the  ship, 
time  the  lighter  was  underway,  the  time  the  lighter  spent  at  the  shore 
facility  and  lighter  succession  times.  It  also  gives  average  and  standard 
deviation  values  for  these  computed  times.  This  program  Is  useful  In  analyzing 
segments  of  lighter  cycles. 

Lighter  and  Cargo  Cycle  Times  Program 

The  Lighter  and  Cargo  Times  program  provides  a  basis  for  analyzing 
Interaction  of  lighter  and  ship  crane  container  transfer  operations.  It 
computes  the  component  parts  of  the  lighter  and  cargo  cycles  at  that 
operating  Interface.  The  results  of  this  program  are  useful  In  analyzing 
lighter  activities  at  the  ship  as  a  part  of  the  total  lighter  cycle  analysis. 

Crane  Cycle  Times  Program 

For  selected  crane  cycles,  this  program  computes  the  mean,  standard 
deviation,  median  and,  as  an  option,  a  histogram.  Selection  criteria  such  as 
direction  of  container  movement,  container  weight,  crane  operator  ID  are 
Inputs  to  the  program.  The  Crane  Cycle  Times  Program  Is  useful  In  analyzing 
crane  cycles  and  the  effects  of  selected  parameters  on  cycle  times  in 
sensitivity  analysis,  learning  curves,  and  the  like. 

ACCESS 


The  programs  and  data  base  described  In  this  report  have  been  copied 
to  magnetic  tape  and  sent  to  the  Joint  Test  Director  at  Ft.  Eustls,  Virginia 
for  file.  Anyone  wishing  to  use  these  programs  should  submit  a  request  to  the 
Commandant,  The  US  Army  Transportation  School,  Ft.  Eustls,  Virginia. 

LOTS  DATA  BASE  . 

The  LOTS  Data  Base  Is  described  In  a  separate  report.1  For  ready  refer¬ 
ence,  the  data  base  structure  Is  given  in  Figure  1.1. 


1  The  BDM  Corporation,  Logistics -Over- the-Shore  (LOTS)  Program  Documentation 
and  User  Information  Report,  BbM/N-7fe-Q$7-TR.  10  January  1978. 
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M*  r ACUITY  ACTIVITKS  MU 

till*  FACILITY  ID  IMAHC  XXXX  M  I  MM 

I  Mt*  FACILITY  LOCATION  MAIM  XXXX  IN  I  MM 


MU 

i  5  2  S  1 1 


n*  m  «•*  ni  <  S 
?  3  u  C  u  u. 
2  Q  >  >•  o  = 

sssssS 

•;;<c9 

|  2  3  2  2  | 

k  s  i  i  i  i 


*s 

..h: 

.Ilssi 

«•  3  3  M  m 


(QOCZ  H*  (9MX  iXli>  IhJlVNOS  31 

•MCZ 

I00C2  Kt  XXX  3k;Vfi»  MQILVUnO  AVI  JO  31 

MZ 

(00C2  Nl  XXXX  AU03J1V3  AVI  JO  31 

•mz 

(UOCZ  Nl  XXXX  iVKVNI  IdAl  AVI 30  31 

MU 

MCI  Nl  UK  U38MAN  U3U  J1NI)  3NU  1N3A1  31 

MU 

;OOC l  Nl  XXXX  1MVN)  ?WVN  1N3A3  31 

MU 

IQW2  Kl  9MI S1N3A3  UJttfttVS  0NV1 

,mz 

IHigi 

tin  if 

£  *  «  m  m  t 

2  5  5  5  5  g 

t  2  2  2  2  < 

jllill 


1 
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10022  Nl  XXXX  3MVN)  N0I1V301  03AI333N  09NV3  31  .CC2Z 
10022  Nl  XXXX  3WVNI  01  03AI333N  0SXV3  31  .OKI 
(0022  Nl  XXXX  3NYW  MAI  03AI333N  09NV3  31  4122 

(0002  Nl  ON)  03AI333H  09HV3  31  .0022 


(0112  Nl  XXXX  3WYNI  N0UV301  033NVM3SI0  03NV3  31  .002 

(0012  Nl  XXXX  3NVNI  01  039NVH9SI0  09NY3  31  4212 

10112  Nl  XXXX  3NYNI  MAI  039NVH3SI3  09NV9  31  4112 

10002  Nl  ON)  039NVH3SI0  09NV3  31  4012 


(0001  Nl  (OF)X  LX3D  1N3WW03  N3IH9I1  .ONI 
(ONI  Nl  XXX  1NVN)  NOIlYNna  AV130  N3LH9I1  4301 
I0NI  Nl  XXXX  3HVNI  AN0931V3  AV130  NUN 911  4MI 
(ONI  Nl  XXXX  3XIVN)  MAI  AV130  NUN 911  4C0I 
I0NI  Nl  SON  N30MN  N3911NI)  3NIA 1N3A3  NUH9I1  4201 
(ONI  Nl  XXXX  3NVN)  3WVN 1N3A3  N31H9I1  4101 

1003 1  Nl  9N)  SLN3A3  H31N9I1  4NI 


(00*  I  Nl  XXXX  SMVNI  N0I1V301  03AI333N  09NV3  .OCSI 
(ONI  Nl  XXXX  SOWN)  01  01AI131N  09NV3  4201 

(ONt  Nl  XXXX  1MVN)  3NAX  03AI333N  09NV3  4101 

(OKI  Nl  9HI  03AI333N  09NV3  4NL 


(0021  Nl  XXXX  3IVVN)  N0ILV301  039NVH3NIO  09NV3  4C2I 
<0021  Nl  XXXX  SMVNI  01  039NVH3U0  09NV3  4221 

(N2I  Nt  XXXX  SOWN)  MAI  039NVM3SM  09NV3  4UI 

(OKI  Nl  9HI  Q39UVH3SIO  09NV3  4021 


(ONI  Nl  XXXX  3HVNI  01 1JVN3  9NI10NVN  4201 
UNI  Nl  XXXX  1MVNI3NA2UVN3  3NI10NVN  4101 

(OKI  Nl  ON)  11VN3  9NI10NVM  4NI 


BASE  STRUCTURE 


It  should  be  noted  that  there  are  significant  voids  in  the  Joint 
LOTS  data  base.  Data  collection  sheets  have  been  reviewed  in  detail  to 
reduce  data  voids  to  a  minimum.  The  remaining  areas  with  significant  voids 
occurred  as  a  result  of  shift  changes  and  periods  of  prolonged  inactivity, 
as  for  example.  In  the  marshaling  yard  at  night  when  data  collection  efforts 
would  stop  and  intermittent  container  arrivals  from  the  beach  would  be  missed. 

An  additional  problem  relates  to  unsynchronized  watches  used  for  timing  events 
at  each  site.  The  differences  vary  from  a  minute  to  as  high  as  eight  or  ten 
minutes.  Thus,  care  must  be  taken  in  analyzing  transit  times  of  container 
movements  from  ship  to  shore,  beach  to  marshaling  yard  and  return.  Likewise, 
the  times  for  containers  to  clear  a  facility  (e.g.,  from  lighter  to  beach, 
beach  to  truck,  truck  to  depart)  must  be  constructed  from  separate  segments 
of  time  to  avoid  watch  synchronization  errors.  (As  many  as  four  data  collectors 
timed  the  lighter,  crane,  frontloader  and  truck  activities  at  a  beach  site.) 
Finally,  some  errors  in  event  times  remain  randomly  scattered  In  the  data 
base  which  were  Incorrectly  recorded  by  the  data  collector  or  Inadvertently 
introduced  during  the  coding  or  key  punching  process.  These  errors  become 
apparent  when  using  programs  for  analyzing  crane  cycles,  lighter  cycles,  etc. 

The  subtraction  of  times  to  compute  time  segments  for  successive  events  pin¬ 
point  such  errors  by  giving  negative  results  or  unrealistically  long  periods 
of  time.  The  most  obvious  of  these  are  multiples  of  hours  (or  60  min.). 

Future  users  of  the  Joint  LOTS  Data  Base  should  Incorporate  error 
checking  routines  In  any  analyses  programs  developed  to  correct  and/or 
discard  data  inconsistencies. 
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II.  CONSISTENCY  CHECK  PROGRAM 


INTRODUCTION 

The  function  of  this  program  Is  to  perform  a  consistency  check  among 
selected  components  within  the  cargo  activities,  lighter  activities  and  land 
carrier  activities  repeating  group  structures  of  the  LOTS  SYSTEM  2000  data 
base. 


The  outputs  flag  invalid  container  identification  numbers  by 
comparison  with  a  control  list;  Indicate  a  "no  match"  whenever  there  Is  an 
Inconsistency  In  data  relating  to  a  container  transfer  from  ship  to  lighter, 
lighter  to  beach  facility,  and  beach  facility  to  truck,  and  finally  from 
truck  to  a  storage  location  In  the  marshaling  yard. 

A  sample  output  Is  given  In  Figures  2.1,  2.2,  and  2.3. 

PROGRAM  DESCRIPTION 

The  Consistency  Check  Program  consists  of  a  system  2000  retrieval 
program,  a  main  program  with  three  subroutines  and  five  functions.  A 
description  of  the  system  2000  retrieval  program  Is  given.  The  description 
of  the  main  program  has  a  structure  diagram,  a  flow  chart  of  the  main  program 
followed  by  a  write-up  of  the  main  program  and  each  routine. 
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LIGHTER  ACTIVITIES  FOR  SHIFT  2,  11  AUGUST  1978.  (FROM  THE  C1500 
REPEATING  GROUP  OF  THE  LOTS  DATA  BASE.) 


Ricrivj'o  t»r? 


FIGURE  2.3.  MATCHR1  SAMPLE  OUTPUT  FOR  THE  ELEVATED  CAUSEWAY  RECEIVING 
LAND  CARRIER  ACTIVITIES  FOR  SHIFT  2,  11  AUGUST  1978.  (FROM  THE  C2000 
REPEATING  GROUP  OF  THE  LOTS  DATA  BASE.) 


SYSTEM  2000  RETRIEVALS  FOR  THE  MATCHR1  FILES 


Purpose 


To  create  five  data  files  for  input  to  the  MATCHR1  consistency  check 

program. 


FILE  NAME  TYPE  USE 


DESCRIPTION 


CIBCA 

BCD 

Output 

CDVLT 

BCD 

Output 

CDVLC 

BCD 

Output 

CRVLT 

BCD 

Output 

CRVLC 

BCD 

Output 

(1)  Cargo  ID 

(2)  Discharging  carrier  ID 

(3)  Discharging  carrier  type 

(4)  Receiving  carrier  ID 

(5)  Receiving  carrier  type 

(6)  Facility  ID 

(7)  Date 

(8)  Shift 

(1)  Cargo  discharged  ID 

(2)  Lighter  ID 

(3)  Lighter  type 
(4  Facility  ID 
(b)  Date 

(6)  Shift 

(1)  LC  Cargo  discharged  ID 

(2)  Land  carrier  ID 

S3)  Land  carrier  type 
4)  Facility  ID 
5)  Date 
(6  Shift 

(1)  LC  Cargo  received  ID 

(2)  Lighter  ID 

(3)  Lighter  type 

(4)  Facility  ID 

(5)  Date 

(6)  Shift 

p ;  LC  Cargo  received  ID 
(2)  Land  carrier  ID 

(3)  Land  carrier  type 
(4  Facility  ID 
(5)  Date 
(6)  Shift 
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CHECK  FOR 
DUPLICATE 
RECORD 


C  A 
VAL 

iLL 

CGID 

f 

CALL 

FDISCID 

1 

' 

CALL 

NSSCCHK 

< 

r 

CALL 

ENTRY 

FOISCID 

2.5.  MAIN  PROGRAM  (MATCHR1)  FLOW  DIAGRAM 


MAIN  PROGRAM  MATCHR1 
Purpose 

To  perform  a  consistency  check  among  selected  components  within  the 
cargo  activies,  lighter  activies,  and  land  carrier  repeating  group  structures  of 
the  LOTS  SYSTEM  2000  data  bases. 


Program  Statement 

PROGRAM  MATCHR1  (CIBCA,  CDVLT,  CDVLC,  CRVLT,  CRVLC,  OUTPUT,  CGIDTS) 


FILE  NAME 

TYPE 

USE 

DESCRIPTION 

CIBCA 

BCD 

Input 

(1)  Cargo  ID 

(2)  Discharging  carrier  ID 

(3)  Discharging  carrier  type 

(4)  Receiving  carrier  ID 

(5)  Receiving  carrier  type 

(6)  Facility  ID 

(7)  Date 

(8)  Shift 

CDVLT 

BCD 

Input 

(1)  Cargo  discharged  ID 

(2)  Lighter  ID 

(3)  Lighter  type 

(4)  Facility  ID 

(5)  Date 

(6)  Shift 

CDVLC  BCD  Input  (1)  LC  Cargo  discharged  ID 

(2)  Land  carrier  ID 

(3)  Land  carrier  type 

(4)  Facility  ID 

(5)  Date 

(6)  Shift 

CRVLT  BCD  Input  (l)  LC  Cargo  received  ID 

(2)  Lighter  ID 

(3)  Lighter  type 

(4)  Facility  ID 

(5)  Date 

(6)  Shift 

CRVLC  BCD  Input  (1)  LC  Cargo  received  ID 

(2)  Land  carrier  ID 

(3)  Land  carrier  type 
4  Facility  ID 

(5;  Date 
(6)  Shift 


Output 

BCD 

Output 

The  above  five  tables  with 
inconsistences  marked  are 
output.  Invalid  cargo  ID 
are  indicated. 

CGIDTS 

BCD 

Input 

Valid  cargo  ID's 

MAIN  MATCHR1 
FUNCTION  FDISCID  (1) 

Purpose 

To  attempt  to  locate  any  entry  in  either  of  the  discharging  transporter 
tables  whose  cargo  and  carrier  IDs  matched  those  passed  by  the  caller. 

Calling  Sequence 

FDISCID  (CGID,  CRID,  CIBCASQ) 


VARIABLE 


DIMENSION 


DESCRIPTION 


CGID 

Integer 

- 

Input 

Carrier  ID 

CRID 

Integer 

- 

Input 

Cargo  ID 

CIBCASQ 

Integer 

- 

Input 

Sequence  number 

COMMON  BLOCKS 

INPUT 

OUTPUT 

CDVLT 

CDLCID, 

CDLTID,  CDLTYP, 

CDLSEQ, 

NUMCDL 

CDVLC 

CDCCID, 

CDCTID,  CDCTYP, 

CDCSEQ, 

NUMCDC 

CRVLT 

CRLCID, 

CRLTID,  CRYTYP, 

CRLSEQ, 

NUMCRL 

CRVLC 

CRCCID, 

CRCTID,  CRCTYP, 

CRCSEQ, 

NUMCRL 

Functions 

Called 

SCANTAB 

MAIN  MATCHR1 


FUNCTION  SCATTAB  (1.1) 
Purpose 


To  scan  appropriate  transporter  table  for  a  match  with  the  record 
currently  being  processed. 


Calling  Sequence 

SCANTAB  (CARGTAB,  CARRTAB,  SQCIBCA,  TABLIM,  TABNAME,  CARGID,  CARRID, 
NSEQ,  STRTSON ) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

CARGTAB 

Integer 

TABLIM 

Input 

Cargo  table 

CARRTAB 

Integer 

TABLIM 

Input 

Carrier  table 

SQCIBCA 

Integer 

TABLIM 

Input 

Sequence  number 

TABLIM 

Integer 

- 

Input 

Dimension  number 

TABNAME 

Integer 

- 

Input 

Table  name 

CARGID 

Integer 

- 

Input 

Cargo  ID 

CARRID 

Integer 

- 

Input 

Carrier  ID 

NSEQ 

Integer 

• 

Input 

Sequence  number  of  CIBCA 
Record 

STRTSON 

Integer 

- 

Output 

Value  of  the  first  entry 

in  the  group  currently 
being  scanned. 


Common  Blocks 
NONE 


Subroutines  Called 


MAIN  MATCHR1 
SUBROUTINE  GDRDATA  (2) 

Purpose 

To  obtain  discharging/ receiving  transporter  data  from  the  appropriate 

files. 

Calling  Sequence 

CALL  GDRDATA 

COMMON  BLOCKS  INPUTS  OUTPUTS 

TBLUNIT  NCIBCA,  NCDVLT,  NCDVLC, 

NCRVLT,  NCRVLC 

CDVLT  CDLCID,  CDLTID,  CDLTYP, 

CDLSEQ,  NUMCDC 

CRVLT  CRLCID,  CRLTID,  CRLTYP , 

CRLSEQ,  NUMCRL 

CRVLC  CRCCID,  CRCTID,  CRCTYP, 

CRCSEQ,  NUMCRL 

Functions  Called 
READTBL 
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MAIN  MATCHR1 


FUNCTION  READTBL  (2.1) 
Purpose 


To  read  values  into  the  cargo,  carrier,  identifier  and  carrier-type 
arrays  from  the  file  whose  unit  number  is  passed  as  the  value  of  the  formal 
parameter  "NUNIT" 

Calling  Sequence 

READTBL  (CARGTBL,  CARRTBL ,  CRTPTBL,  SEQTBL,  NUNIT,  FNAME ,  CALL!) 


VARIABLE 

TYPE 

DIMENSION 

iMaMas 

DESCRIPTION 

CARGTBL 

Integer 

300 

Output 

Cargo  ID 

CARRTBL 

Integer 

300 

Output 

Carrier 

CRTPTBL 

Integer 

300 

Output 

Carrier  type 

SEQTBL 

Integer 

300 

Output 

Sequence  number 

NUNIT 

Integer 

- 

Input 

Number  of  file 

FNAME 

Integer 

- 

Input 

Name  of  file 

CALL! 

Logical 

- 

Input 

First  call  flag 

Common  Blocks 

Inputs 

Outputs 

NREPORT 

NREPORT 

NORMAN 1 

CURFID,  CURDATE, 

CURSHIFT 

Functions  Called 

VLDCCID 


MAIN  MATCHR1 


FUNCTION  NSSCCHK  (3) 
Purpose 


To  determine  if  NSSC  code  is  unique. 
Calling  Sequence 


NSSCCHK  (IDENT, 

SEQ) 

VARIABLE 

TYPE 

DIMENSION 

USE 

I  DENT 

Integer 

• 

Input 

SEQ 

Integer 

- 

Input 

Common  Blocks 

Input 

Output 

NREPORT 

NSSCDUP 

NREPORT 

NSSCDUP 

Subroutines  Called 
NONE 


DESCRIPTION 

NSSC  CODE 
Sequence  number 
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MAIN  MATCHR1 
SUBROUTINE  TBLDUMP  (4) 
Purpose 


To  supervise  the  writing  of  the  four  transporter  tables. 


Calling  Sequence 

TBLDUMP 

Common  Blocks 

Input 

Output 

DRTERRS 

DLUNREP ,  DCUNREF,  RLUNREF, 

DLDUPL,  DCDUPL,  RLDUPL,  RCDUPL, 
DLINVAL.DCINVAL,  RLINVAL,  RCINVAL 

CDVLT 

CDLCID,  CDLTID, 
CDLTYP,  CDLSEQ, 
NUMCDL 

CDVLC 

CDCCID,  CDCTID, 

CDCTYP.CDCSEQ, 

NUMCDC 

CRVLT 

CRLCID.CRLTID, 

CRLTYP.CRLSEQ, 

NUMCRL 

CRVLD 

CRCCID.CRCTID, 

CRCTYP.CRCSEQ, 

NUMCRC 

Subroutines  Called 


DUMSTER 


2-14 


MAIN  MATCHR1 


SUBROUTINE  DMPSTER  (4.1) 

Purpose 

To  write  any  one  of  four  transporter  tables. 

Calling  Sequence 

DMPSTER  (CARGTBL,  CARRTBL ,  TYPETBL,  SEQTBL,  TBLSIZE,  HEADING, NERARAY) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

CARTBL 

Integer 

TBLSIZE 

Input 

Cargo  table 

CARRTBL 

Integer 

TBLSIZE 

Input 

Carrier  table 

TYPETBL 

Integer 

TBLSIZE 

Input 

Type  of  transporter  table 

SEQTBL 

Integer 

TBLSIZE 

Input 

Sequence  number  of 
record  in  table 

TBLSIZE 

Integer 

- 

Input 

Dimension  number 

HEADING 

Real 

- 

Input 

Table  Heading 

NERARAY 

Integer 

3 

Output 

(1)  Number  unreferrence 

Common  Blocks 
NORMAN 1 
TITLE 
NREPORT 

Subroutines  Called 


Input 

FACILID,  DATE,  SHIFT 
CDATE ,CTIME .DBNAME 
NREPORT,  PAGE 


records 

(2)  Number  duplicate  records 

(3)  Number  invalid  cargo  IDs 

Output 


MAIN  MATCHR1 
FUNCTION  VLDCGIO  (5) 

Purpose 

To  determine  If  cargo  ID  is  on  the  valid  list  of  cargo  IDs. 


Calling  Sequence 

VLDCGID  (IDENT) 

VARIABLE  TYPE 

DIMENSION 

USE 

DESCRIPTION 

IDENT  Integer 

- 

Input 

Cargo  ID 

Common  Blocks 

Inputs 

Outputs 

CGTUNIT 

CTUNIT 

NREPORT 

NREPORT 

Subroutines  Called 


COMMON  BLOCK  CDVLC 

Name  Type 

Dimension 

CDCCID 

Integer 

300 

CDCTID 

Integer 

300 

CDCTYP 

Integer 

300 

CDCSEQ 

Integer 

300 

NUMCDC 

Integer 

COMMON  BLOCK  COVLT 

COLCID 

Integer 

300 

CDLTID 

Integer 

300 

CDLTYP 

Integer 

300 

CDLSEQ 

Integer 

300 

NUMCDL 

Integer 

COMMON  BLOCK  CGTUNIT 

NCGUNIT 

Integer 

— 

COMMON  BLOCK  CRVLC 

CRCCID 

Integer 

300 

CRCTID 

Integer 

300 

CRCTYP 

Integer 

300 

CRCSEQ 

Integer 

300 

NUMCRC 

Integer 

... 

COMMON  BLOCK  CRVLT 

CRLCID 

Integer 

300 

CRLTID 

Integer 

300 

CRLTYP 

Integer 

300 

CRLSEQ 

Integer 

300 

NUMCRL 

Integer 

COMMON  BLOCK  DRTERRS 

DLUNRER 

Integer 

— 

Description 

Discharging  Land  Carrier  Cargo  ID 
Discharging  Land  Carrier  ID 
Discharging  Land  Carrier  Type 
Discharging  Land  Carrier  Sequence  Number 
Number  of  Discharging  Land  Carrier  Records 


Discharging  Lighter  Cargo  ID 
Discharging  Lighter  ID 
Discharging  Lighter  Type 
Discharging  Lighter  Sequence  Number 
Number  of  Discharging  Lighter  Records 


I/O  Unit  Number 


Receiving  Land  Carrier  Cargo  ID 
Receiving  Land  Carrier  ID 
Receiving  Land  Carrier  Type 
Receiving  Land  Carrier  Sequence  Number 
Number  of  Receiving  Land  Carrier  Records. 


Receiving  Lighter  Cargo  ID 
Receiving  Lighter  ID 
Receiving  Lighter  Type 
Receiving  Lighter  Sequence  Number 
Number  of  Receiving  Lighter  Records 


Number  of  Discharging  Lighter  Non-Matches 
Records 


COMMON  BLOCK  ORTERRS  (CONT.) 


Name 

Jm 

Dimension 

DCUNRER 

Integer 

- — 

RLUNREF 

Integer 

_ _  _ 

RCUNREF 

Integer 

— 

DLDUP 

Integer 

_  _  _ 

DCDUP 

Integer 

— 

RLDUPL 

Integer 

_  _  _ 

RCDUP 

Integer 

— 

DLINVAL 

Integer 

— 

DCINVAL 

Integer 

— 

RLINVAL 

Integer 

— 

RCINVAL 

Integer 

— 

NFLRECS 

Integer 

NDCRECS 

Integer 

— 

NRLRECS 

Integer 

NRCRECS 

Integer 

— 

COMMON  BLOCK  NORMAN 1 

PRVFID 

Integer 

--- 

PRVDATE 

Integer 

- - 

PRVSHFT 

Integer 

... 

COMMON  BLOCK  NREPORT 

NREPORT 

Integer 

— 

Description 

Number  of  Discharging  Land  Carrier 
Non-Matches 

Number  of  Receiving  Lighter  Mon-Matches 

Number  of  Receiving  Land  Carrier 
Non-Matches 

Number  of  Discharging  Lighter  Duplicates 

Number  of  Discharging  Land  Carrier 
Dupl icates 

Number  of  Receiving  Lighter  Duplicates 

Number  of  Receiving  Land  Carrier 
Duplicates 

Number  of  Discharging  Lighter  Invalid 
Cargo  IDs 

Number  of  Discharging  Land  Carrier 
Invalid  Cargo  IDs 

Number  of  Invalid  Receiving  Lighter 
Invalid  Cargo  IDs 

Number  of  Receiving  Land  Carrier  Invalid 
Cargo  IDs. 

Total  Discharging  Lighter  Records 

Total  Discharging  Land  Carrier  Records 

Total  Receiving  Lighter  Records 

Total  Receiving  Land  Carrier  Records 


Facility  ID  on  Previous  Record 
Date  on  Previous  Record 
Shift  on  Previous  Record 


I/O  Unit  Number 


COMMON  BLOCK  NSSCDUP 
NSSCDUP  Integer 


Number  of  NSSC  Duplicate  Codes 


COMMON  BLOCK  PAGENUM 


Name 

Jl 2S. 

Dimension 

Description 

NPAGE 

Integer 

Current  Output  Page  Number 

COMMON  BLOCK  T8LUNIT 

NCIBCA 

Integer 

I/O  Unit  Number 

NCDULT 

Integer 

— 

I/O  Unit  Number 

NCDVLC 

Integer 

— 

I/O  Unit  Number 

NCRVLT 

Integer 

— 

I/O  Unit  Number 

NCRVLC 

Integer 

I/O  Unit  Number 

COMMON  BLOCK  TITLE 

CDATE 

Real 

_  _ 

Current  Date 

CTIME 

Real 

— 

Current  Time 

DBNAME 

Real 

— 

Data  Base  Name 

III.  LIGHTER  CYCLE  TIMES  PROGRAM 


INTRODUCTION 

The  Lighter  Cycle  Times  Program  traces  lighters  carrying  containers 
between  ship  and  shore  facilities.  The  following  information  is  given  for 
each  lighter  at  the  ship: 

1)  Ship  facility 

2)  Date 

3)  Shift 

4)  Lighter  type 

5)  Lighter  ID 

6)  Lighter  cycle 

7)  Lighter  position  at  the  ship 

8)  Forward  or  retrograde  movement 

9)  Lighter  ready  at  the  ship  time  (LDRY) 

10)  Lighter  ready  to  depart  the  ship  time  (LRDP) 

11)  Lighter  at  the  ship  time  (LRDP-LRDY) 

Data  for  the  shore  part  of  the  record  are: 

1)  Shore  facility 

2)  Lighter  arrived  at  the  shore  time  (LARR) 

3)  Lighter  unclear  way  time  (LARR  at  the  shore-LRDP  at  the  ship) 

4)  Lighter  In  position  at  the  shore  time  (LPSN) 

5)  Lighter  position  time  (LPSN-LARR) 

6)  Lighter  ready  at  the  shore  time  (LRDY) 

7)  Lighter  ready  time  (LRDY-LPSN) 

8)  Lighter  ready  to  depart  the  shore  (LRDP) 

9)  Lighter  at  crane  time  (LRDP-LRDY) 

10)  Lighter  succession  time  (LRDY-previous  LRDP) 

11)  Previous  lighter  type 


The  mean  and  standard  deviation  are  computed  and  presented  in  the  output  for 
all  time  differences  by  ship  facility,  date  and  shift. 

A  sample  output  is  given  in  Figure  3.1. 

PROGRAM  DESCRIPTION 

The  Lighter  Cycle  Times  Program  consists  of  two  System  2000  retrieval 
programs,  five  main  programs  containing  32  subprograms,  four  sorts  and  one 
merge.  A  flow  chart  of  the  steps  in  this  program  is  given  in  Figure  3.2.  A 
description  of  each  program  is  given  starting  with  the  two  System  2000  retrieval 
programs  and  followed  by  the  five  main  programs.  The  description  of  each  main 
program  contains  a  structure  diagram,  a  flow  chart  of  the  main  program,  and  a 
write-up  of  the  main  program  and  each  subroutine. 


FIGURE  3.1.  LIGHTER  CYCLE  TIMES  PROGRAM  SAMPLE  OUTPUT 


SYSTEM  2000  RETRIEVALS  FOR  THE  SHIP  FILES 


Purpose 


To  retrieve  lighter  data  at  the  ship  from  the  LOTS  System  2000  data 

base  and  to  store  the  data  on  four  files. 


FILE  NAME  TYPE 

LRDY1  BCD 


LRDP1  BCD 


FI  BCD 


R1  BCD 


USE  DESCRIPTION 

Output  A  LRDY1  record  contains: 

(1)  Facility  ID  (COD  or  TCDF) 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 
(7/  Lighter  position 

(8)  Lighter  event  time  (LRDY) 

Output  A  LRDP1  record  contains: 

(1)  Facility  ID  (COD  or  TCDF) 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LRDP) 

Output  A  FI  record  indicates  forward  lighter 

movement.  The  record  contains: 

(1)  Facility  ID  (COD  or  TCDF) 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Forward  (an  F  is  added  to  this  file 
using  the  system  editor). 

Output  A  R1  record  indicates  retrograde  lighter 

movement.  The  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Retrograde  (an  R  is  added  to  this  record 
using  the  system  editor). 


SYSTEM  2000  RETRIEVALS  FOR  THE  SHORE  FILES 


Purpose 


To  retrieve  lighter  data  at  the  shore  from  the  LOTS  System  2000  data 
base  and  to  store  the  data  on  four  data  bases. 


FILE  NAME  TYPE 

LARR2  BCD 


LPSN2  BCD 


LRDY2  BCD 


LRDP2  BCD 


USE  DESCRIPTION 

Output  A  LARR2  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LARR) 

Output  A  LPSN2  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LPSN) 

Output  A  LRDY2  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 
3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LRDY) 

Output  A  LRDP2  record  contains: 

p)  Facility  date 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LRDP) 


FIGURE  3.4.  MAIN  PROGRAM  (SHPGEN)  FLOW  DIAGRAM 


MAIN  PROGRAM  SHPGEN 


Purpose 


To  combine  three  records,  contained  in  the  System  2000  ship  files,  into 
one  record. 


Program  Statement 

PROGRAM  SHPGEN  (LRDY1,  LRDP1 ,  FR1 ,  0UTI1,  0UTC1,  OUTPUT,  0UTBN1) 


FILE  NAME 

TYPE 

USE 

DESCRIPTION 

LRDY1 

BCD 

Input 

A  LRDY1  record  contains: 

(1 )  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 
(51  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Lighter  event  time  (LRDY) 

LRDP1 

BCD 

Input 

A  LRDP1  records  contains: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(41  Lighter  type 

(5)  Lighter  ID 

(61  Lighter  cycle 

(7)  Lighter  event  time  (LRDP) 

NFR 

BCD 

Input 

A  NFR  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 

3)  Shift 

(41  Lighter  type 
(51  Lighter  ID 

(6)  Lighter  cycle 

(7)  Foreward  or  retrograde  (F/R) 

0UTI1 

BCD 

Output 

Any  LRDY1 ,  LRDP2  or  NFR  record  that 
doesn't  have  matching  records  in  the 
other  two  files. 

FILE  NAME 


DESCRIPTION 


A  OUTC1  record  contains: 

M)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Forward  or  retrograde  ( F/R ) 

(9)  Lighter  event  time  (LRDY) 

(10)  Lighter  event  time  (LRDP) 

(11)  Lighter  Ship  time  (LRDP-LRDY) 

(12)  Minutes  elapsed  from  the  beginning 
of  the  test. 

Contains  system  messages,  if  any. 
Contains  the  same  record  as  0UTC1 . 


MAIN  SHPGEN 


SUBROUTINE  READ  (1) 

Purpose 

To  read  one  record  from  one,  two  or  three  input  files  depending  on 
the  value  of  KODE. 


Calling  Sequence 

CALL  READ  (KODE,  NLRDY,  NLRDP,  NFR,  NLGTPS,  NPAM,  NFIRST,  NEND) 


Variable 

Im. 

Dimension 

Use 

Description 

KODE 

Integer 

3 

Input 

(1)  Flag  to  read  a  file  1  record. 

(2)  Flag  to  read  a  file  2  record. 

(3)  Flag  to  read  a  file  3  record. 

NFIRST 

Logical 

• 

Input 

Equals  false  on  first  call  and  true 
on  additional  calls. 

NLRDY 

Integer 

6 

Output 

First  six  parameters  of  input  file 

1  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

NLRDP 

Integer 

6 

Output 

First  six  parameters  of  input  file 

2  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

NFR 

Integer 

6 

Output 

First  six  parameters  of  input  file 

3  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

NLGTPS 

Integer 

** 

Output 

Seventh  parameter  of  input  file  1 
record;i.e.,  lighter  position. 

NPAM 

Integer 

3 

Output 

Last  parameter  of  each  of  the  three 
input  file  records,  i.e., 

(1)  File  1  record- lighter  event  time 
(LRDY ) 

(2)  File  2  record- 1 ighter  event  time 
(LRDY) 

(3)  File  3  record- foreward  or  retro¬ 
grade  movement  (F/R) 

Output  Equals  EOF  when  end-of-file  is  reached 


NEND 


Integer 


3 


MAIN  SHPGEN 


SUBROUTINE  COMPARE  (2) 


Purpose 

To  determine  if  two  records  match  on  six  match  keys.  If  there  is 


no  match, 
failed. 

it  returns 

to  the  main 

program 

Calling  Sequence 

CALL  COMPARE  (NTEST1, 

NTEST2, 

Variable 

NTEST1 

Jm. 

Integer 

Dimension 

6 

Use 

Input 

NTEST2 

Integer 

6 

Input 

MATCH 

Logical 

- 

Input 

NFAIL1 

Integer 

- 

Output 

NFAIL2 

Integer 

- 

Output 

Common  Blocks 

Block  Name 

None 

Inputs 

None 

the  first  match  key  where  the  match 


MATCH,  NFAIL1,  NFAIL2) 

Description 

Contains  the  lighter  ready  record 
(six  match  keys). 

Contains  the  lighter  ready  to  depart 
or  foreward/retrograde  record  (six 
match  keys). 

MATCH  equals  true  if  a  match  was 
found.  MATCH  equals  false  if  the 
match  failed. 

Contains  the  first  lighter  ready 
match  key  where  the  match  failed. 
Contains  the  first  lighter  ready  or 
the  first  foreward/ retrograde  match 
key  where  the  match  failed. 


Output 

None 


Subrouti nes  Called 


MAIN  SHPGEN 


SUBROUTINE  SELECT  (3) 

Purpose 

To  determine  which  record  to  read. 
Calling  Sequence 

CALL  SELECT  (KEY,  NFAIL1,  NFAIL2,  KODE) 


Variable 

Type  Dimension 

Use 

KEY 

Integer 

Input 

NFAIL1 

Integer 

- 

Input 

NFAIL2 

Integer 

- 

Input 

KODE 

Integer 

3 

Outpu 

Common  Blocks 

Block  Name  Input 

None  None 


Description 

When  KEY  equals  1,  the  match  between 
a  lighter  ready  record  and  a  lighter 
ready  to  depart  record  failed.  When 
KEY  equals  2,  the  match  between  a 
lighter  ready  record  and  a  forward/ 
retrograde  record  failed. 

Contains  the  first  lighter  ready 
match  key  where  the  match  failed. 
Contains  the  first  lighter  ready 
or  the  first  foreward/retrograde 
match  key  where  the  match  failed. 

If  match  failed: 

(1)  Flag  to  indicate  an  incomplete 
file  1  record. 

(2)  Flag  to  indicate  an  incomplete 
file  2  record. 

(3)  Flag  to  indicate  an  incomplete 
file  3  record. 


Output 

None 


Subroutines  Called 


MAIN  SHPGEN 


SUBROUTINE  CONVERT  (4) 

Purpose 

Converts  day,  shift,  hours, 
of  the  test. 


Calling  Sequence 


and  minutes  to  minutes  from  the  beginning 


CALL  CONVERT  (NDAY, 

NSHIFT, 

NHM,  MINS) 

Variable 

Type  Dimension 

Use 

Description 

NDAY 

Integer 

Input 

Julian  date. 

NSHIFT 

Integer 

Input 

Shift  1  or  shift  2. 

NHM 

Integer 

Input 

Time  of  day  in  hours  and  minutes 
(military  time). 

MINS 

Integer 

Output 

Minutes  elapsed  from  the  beginning 
of  the  test. 

Common  Blocks 

Block  Name  Input 

None  None 


Subroutines  Called 
None 


3-15 


MAIN  SHPGEN 


SUBROUTINE  RPTINC  (5) 
Purpose 


To  write  an  incomplete  record. 

Calling  Sequence 

CALL  RPTINC  (KODE,  NLRDY,  NLRDP,  NFR,  NLGTPS,  NPAM,  NFINC) 


Variable 

KODE 

Integer 

Dimension 

3 

Use 

Input 

NLRDY 

Integer 

6 

Input 

NLRDP 

Integer 

6 

Input 

NFR 

Integer 

6 

Input 

NLGTPS 

Integer 

Input 

NPAM 

Integer 

3 

Input 

NFINC 

Logical 

Input 

Description 

(1)  Flag  to  write  a  file  1  record. 

(2)  Flag  to  write  a  file  2  record. 

(3)  Flag  to  write  a  file  3  record. 

First  six  parameters  of  input  file  1 
record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

First  six  parameters  of  input  file  2 
record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

First  six  parameters  of  input  file  3 
record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

Seventh  parameter  of  input  file  1 
record,  i.e.,  lighter  position. 

Last  parameter  of  each  of  the  three 
input  file  records,  i.e., 

(1)  File  1  record-lighter  event  time 
(LRDY) 

(2)  File  2  record-lighter  event  time 
(LRDY) 

(3)  File  3  record- forward  or  retro¬ 
grade  movement  (F/R) 

Equals  false  on  first  call  and  true 
on  additional  calls.  When  NFINC  equal 
false,  automatically  prints  complete 
record  file  title. 


Common  Blocks 

Block  Name  Input  Output 

TBLUNIT  NUNIT4  None 


Subroutines  Called 


MAIN  SHPGEN 


SUBROUTINE  RPTCOM  (6) 

Purpose 

To  write  a  complete  record. 

Calling  Sequence 

CALL  RPTCOM  (NLRDY,  NLGTPS,  NPAM,  NFCOM,  LSHPT,  MINS) 


Variable  Type  Dimension  Use 


NLRDY 

Integer  6 

Input 

NLGTPS 

Integer 

Input 

NPAM 

Integer  3 

Input 

NFCOM 

Logical 

Input 

LSHPT 

MINS 

Integer 

Integer 

Input 

Input 

Common  Blocks 

Block  Name 

TBLUNIT 

Input 

NUNIT5,  NUNIT7 

Description 

First  six  parameters  of  input  file  1 
record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

Seventh  parameter  of  input  file  1 
record,  i.e.,  lighter  position. 

Last  parameter  of  each  of  the  three 
input  file  records,  i.e., 

(1)  File  1  record-lighter  event  time 
(LRDY) 

(2)  File  2  record-lighter  event  time 
(LRDY) 

(3)  File  3  record-forward  or  retro¬ 
grade  movement  (F/R). 

Equals  false  on  first  call  and  true 
on  additional  calls.  When  NFCOM 
equals  false,  automatically  prints 
complete  record  file  title. 

Lighter  at  ship  time  (LRDP-LRDY). 
Minutes  elapsed  from  the  beginning 
of  the  test. 


Output 

None 


Subroutines  Called 


MAIN  SHPGEN 


SUBROUTINE  STOP  (7) 

Purpose 

To  determine  if  end-of-file  is  in  any  or  in  all  files.  Sets  KODE 
to  write  incomplete  records. 

Calling  Sequence 


CALL  STOP 

(NEND,  NSTOP, 

NST0P1 , 

KODE) 

Variable 

Type 

Dimension 

Use 

Description 

NEND 

Integer 

3 

Input 

Equals  EOF  when  end  of  file  is  reached 

NSTOP 

Integer 

Output 

When  NSTOP  is  false,  all  files  contain 
data.  When  NSTOP  is  true,  at  least 
one  file  is  out  of  data. 

NST0P1 

Logical 

- 

Output 

When  NST0P1  is  true,  all  files  are 
out  of  data. 

KODE 

Integer 

3 

Output 

(1)  Flag  to  read  a  file  1  record. 

(2)  Flag  to  read  a  file  2  record. 

(3)  Flag  to  read  a  file  3  record. 


Common  Blocks 

Block  Name  Input  Output 

None  None  None 

Subroutines  Called 


FIGURE 


START 


CALL 

COMPARE 


FIGURE  3.6.  MAIN  PROGRAM  (SHRGEN)  FLOW  DIAGRAM 


MAIN  PROGRAM  SHRGEN 
Purpose 


To  combine  the  four  records,  contained  in  the  system  2000  shore  files, 
into  one  record. 

Program  Statement 

PROGRAM  SHRGEN  (LARR2,  LPSN2,  LRDY2,  LRDP2,  0UTI2,  0UTC2,  0UTBN2,  OUTPUT) 


FILE  NAME 

TYPE 

USE  DESCRIPTION 

LARR2 

BCD 

Input  A  LARR2  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LARR) 

LPSN2 

BCD 

Input  A  LPSN2  record  contains: 

(11  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LRDP) 

LRDY2 

BCD 

Input  A  LRDY2  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 
(3  Shift 

(4)  Lighter  type 

5  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LRDY) 

LRDP2 

BCD 

Input  A  LRDP2  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 

3  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LRDP2) 

OUT  1 2 


BCO 


Output 


Any  LARR2,  LPSN2,  LRDY2  or  LRDP2  record 
that  doesn't  have  a  matching  records  in 
the  other  three  files. 


FILE  NAME 
0UTC2 


0UTBN2 


TYPE 

BCD 


Binary 


USE  DESCRIPTION 

Output  A  0UTC2  record  contains: 

(1 )  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LARR) 

(8)  Lighter  event  time  (LPSN) 

(9)  Lighter  event  time  (LRDY) 

(10)  Lighter  event  time  (LRDP) 

(11)  Lighter  in  position  time  (LPSN-LARR) 

(12)  Lighter  ready  time  (LRDY-LPSN) 

(13)  Lighter  at  crane  time  (LRDP-LPSN) 

(14)  Minutes  elapsed  from  the  beginning 
of  the  test. 

Output  Contains  the  same  record  as  0UTC2. 

Output  Contains  systems  messages,  if  any. 


OUTPUT 


BCD 


MAIN  SHRGEN 


SUBROUTINE  READ  (1) 

Purpose 

To  read  one  record  from  any  of  four  files  depending  on  the  vaule  of 

KODE. 


Calling  Sequence 


CALL  READ  (KODE,  NLARR,  NLPSN,  NLRDY,  NLRDP,  NFIRST,  NEND) 


Variable  Type 
KODE  Integer 


Dimension 


Use 

Input 


Output 


Output 


Output 


Output 


Description 


(1)  Flag  to  read  a  fil 

(2)  Flag  to  read  a  fil 

(3)  Flag  to  read  a  fil 

(4)  Flag  to  read  a  fil 
First  seven  parameters 
file  1  record,  i .e. , 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time 
First  seven  parameters 
file  2  record,  i .e. , 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time 
First  seven  parameters 
file  3  record ,  i . e . , 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time 
First  seven  parameters 
file  4  record,  i .e. , 

(1)  Facilty  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time 


e  1 
e  2 
e  3 
e  4 


record. 

record. 

record. 

record. 


of  input 


(LARR) 
of  input 


(LPSN). 
of  input 


(LRDY) 
of  input 


(LRDP) 


NFIRST  Logical 
NEND  Integer 
Common  Blocks 


4 


Output  Equals  false  on  first  call  and  true 
on  additional  calls. 

Output  Equals  EOF  when  end-of-file  is  reached. 


Block  Name  Input  Output 

TBLUNIT  NUNIT1,  NUNIT2,  NUNIT3,  None 

NUNIT4,  NUNIT5,  NUNIT6, 

NUNIT7,  NUNIT8 


Subroutines  Called 
None 


3-26 


MAIN  SHRGEN 
SUBROUTINE  COMPARE  (2) 

Purpose 

To  determine  if  two  records  match  on  six  match  keys.  If  there  is 
no  match,  it  returns  to  the  main  program  the  first  match  key  where  the  match 
failed. 

Calling  Sequence 


CALL  COMPARE 

(NTEST1, 

NTEST2,  1 

'iATCH,  NFAIL1,  NFAIL2) 

Variable 

1m 

Dimension 

Use 

Description 

NTEST1 

Integer 

7 

Input 

Contains  the  lighter  arrival  record 
(six  match  keys). 

NTEST2 

Integer 

7 

Input 

Contains  the  lighter  in  position, 
the  lighter  ready,  or  the  lighter 
ready  to  depart  record  (six  match 
keys). 

MATCH 

Logical 

Output 

MATCH  equals  true  if  a  match  was 
found.  MATCH  equals  false  if  the 
match  failed. 

NFAIL1 

Integer 

“ 

Output 

Contains  the  first  lighter  arrival 
match  key  where  the  match  failed. 

NFAIL2 

Integer 

Output 

Contains  the  first  lighter  in  position, 
lighter  ready,  or  lighter  ready  to 
depart  match  key  where  the  match  failed 

Common  Blocks 

Block  Name  Input  Output 

None  None  None 


Subroutines  Called 


MAIN  SHRGEN 


SUBROUTINE  SELECT  (3) 

Purpose 

To  determine  which  record  to  read. 
Calling  Sequence 

CALL  SELECT  (KEY,  NFAIL1,  NFAIL2,  KODE) 


Variable  Type  Dimension  Use 

KEY  Integer  -  Input 


NFAIL1 

Integer 

- 

Input 

NFAIL2 

Integer 

- 

Input 

KODE 

Integer 

4 

Common  Blocks 

Block  Name  Input 

None  None 


Description 

When  KEY  equals  1,  the  match  between 
a  lighter  arrival  record  and  a  lighter 
in  position  record  failed.  When 
KEY  equals  2,  the  match  between  a 
lighter  arrival  record  and  a  lighter 
ready  record  failed.  When  KEY  equals 
3,  the  match  between  a  lighter  arrival 
record  and  a  lighter  ready  to  depart 
record  failed. 

Contains  the  first  lighter  arrival 
match  key  where  the  match  failed. 
Contains  the  first  lighter  in  position 
match  key  where  the  match  failed. 

If  match  failed: 

(1)  Flag  to  indicate  an  incomplete 
file  1  record. 

(2)  Flag  to  indicate  an  incomplete 
file  2  record. 

(3)  Flag  to  indicate  an  incomplete 
file  3  record. 

(4)  Flag  to  indicate  an  incomplete 
file  4  record. 


Output 

None 


Subroutines  Called 


MAIN  SHRGEN 


SUBROUTINE  COMPUTE  (4) 


Purpose 

To  compute  lighter  in  position  time,  lighter  ready  time,  lighter  at 
crane  time,  and  time  elapsed  from  the  beginning  of  the  test. 

Calling  Sequence 

CALL  COMPUTE  (NLARR,  NLPSN,  NLRDY,  NLRDP,  NTIME) 


Variable  Type 


R 


Dimension 


Input 


Input 


Input 


Input 


Output 


Description 


First  seven  parameters  of  input 
file  1  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LARR) 

First  seven  parameters  of  input 
file  2  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LPSN) 

First  seven  parameters  of  input 
file  3  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LRDY) 

First  seven  parameters  of  input 
file  4  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LRDP) 

(1)  Equals  lighter  in  position  time 
(LPSN-LARR) 

(2)  Equals  lighter  ready  time  (LRDY-LPSN) 


(3)  Equals  lighter  at  crane  time 
(LRDP-LRDY) 

(4)  Equals  time  from  the  beginning  of 
the  test  (LRDY). 

Common  Blocks 

Block  Name  Input  Output 

None  None  None 


Subroutines  Called 
Convert 


MAIN  SHRGEN 

SUBROUTINE  CONVERT  (4.1) 

Purpose 

Converts  days,  shifts,  hours,  and  minutes  to  minutes  from  the  beginning 
of  the  test. 


CALL  CONVERT  (NARRAY,  MINS) 


Variable 

Type  Dimension 

Use 

Description 

NARRAY 

Integer  7 

Input 

(2)  Julian  date 

(3)  Shift 

(7)  Time  of  day  in  hours  and  minutes 
(military  time). 

MINS 

Integer 

Output 

Minutes  elapsed  from  the  beginning 
of  the  test. 

Common  Blocks 

Block  Name 

Input 

Output 

None 

None 

None 

Subroutines  Called 
None 


MAIN  SHRGEN 


SUBROUTINE  RPTINC  (5) 


Purpose 


Calling 

To  write  an  incomplete  record. 

Sequence 

CALL  RPTINC  (KODE,  NLARR,  NLPSN, 

Variable 

Dimension 

Use 

KODE 

Integer 

4 

Input 

NLARR 

Integer 

7 

Input 

NLPSN 

Integer 

7 

Input 

NLRDY 

Integer 

7 

Input 

NLRDP 

Integer 

7 

Input 

Description 

(1)  Flag  to  write  a  fi 

(2)  Flag  to  write  a  fi 

(3)  Flag  to  write  a  fi 

(4)  Flag  to  write  a  fi 
First  seven  parameters 
file  1  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time 
First  seven  parameters 
file  2  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time 
First  seven  parameters 
file  3  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time 
First  seven  parameters 
file  4  record,  i.e., 

(1)  Facilty  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time 


le  1  record, 
le  2  record, 
le  3  record, 
le  4  record, 
of  input 


(LARR) 
of  input 


(LPSN) 
of  input 


(LRDY ) 
of  input 


(LRDP) 


NFINC 


Logical 


Input  Equals  false  on  first  call  and  true 
on  additional  calls.  When  NFINC 
equals  false,  automatically  prints 
complete  record  file  title. 


Common  Blocks 

Block  Name 

Input 

Output 

TBLUNIT 

NUNIT1, 

NUNIT4, 

NUNIT7, 

NUNIT2, 
NUNIT5 , 
NUNIT8 

NUNIT3, 

NUNIT6, 

None 

Subroutines  Called 


MAIN  SHRGEN 


SUBROUTINE  RPTCOM  (6) 


Purpose 


To  write  a  complete  record. 


Calling  Sequence 


CALL  RPTCOM  (NLARR,  NLPSN,  NLRDY,  NLRDP,  NTIME,  NFCOM) 


Variable  Type  Dimension 


Description 

First  seven  parameters  of  input 
file  1  record,  i .e. , 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LARR) 

First  seven  parameters  of  input 
f i 1 e  2  record,  i .e. , 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LPSN) 

First  seven  parameters  of  input 
file  3  record,  i.e., 

(1)  Facilty  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LRDY) 

First  seven  parameters  of  input 
file  4  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LRDP) 

(1)  NTIME1  equals  lighter  in  position 
time  (LPSN-LARR) . 

(2)  NTIME2  equals  lighter  ready  time 
(LRDY-LPSN). 


(3)  NTIME3  equals  lighter  at  crane 
time  (LRDP-LPSN). 

(4) NTIME4  equals  time  from  the  beginning 
of  the  test  (LRDY). 

NFCOM  Logical  -  Input  Equals  false  on  first  call  and  true 

on  additional  calls.  When  NFCOM 
equals  false,  automatically  prints 
complete  record  file. 


Common  Blocks 


Block  Name  Input  Output 

TBLUN1T  NUNIT1 ,  NUNIT2,  NUNIT3,  None 

NUNIT4,  NUNIT5,  NUNIT6, 

NUNIT7,  NUNIT8 

Subroutines  Called 
None 


3-35 


MAIN  SHRGEN 


SUBROUTINE  STOP  (7) 

Purpose 

To  determine  if  end-of-file  is 
to  write  incomplete  records. 

Calling  Sequence 

CALL  STOP  (NEND,  NSTOP,  NST0P1, 


Variable 

Dimension 

Use 

NEND 

Integer 

4 

Input 

NSTOP 

Logical 

Output 

NSTOP 1 

Logical 

- 

Output 

KODE 

Integer 

4 

Output 

Common  Blocks 

Block  Name  Input 

None  None 


in  any  or  in  all  files.  Sets  KODE 


KODE} 

Description 

Equals  EOF  when  end-of-file  is  reached. 
When  NSTOP  is  false,  all  files  contain 
data.  When  NSTOP  is  true  at  least  one 
file  is  out  of  data. 

When  NST0P1  is  true,  all  files  are  out 
of  data. 

(1)  Flag  to  read  a  file  1  record. 

(2)  Flag  to  read  a  file  2  record. 

(3)  Flag  to  read  a  file  3  record. 

(4)  Flag  to  read  a  file  4  record. 


Output 

None 


Subroutines  Called 


FIGURE  3.9.  MAIN  PROGRAM  (PREV)  FLOW  DIAGRAM 


MAIN  PROGRAM  PREV 


Purpose 


To  save  previous  lighter  type  and  previous  LRDP  (SHORE)  on  present 
record.  To  compute  lighter  succession  time  at  the  shore. 


Program  Statement 

PROGRAM  PREV  (TAPE!,  OUT,  OUTPUT) 


FILE  NAME  TYPE 

TAPE1  Binary 


OUT  Binary 


OUTPUT  BCD 


USE 

Input 


Output 


Output 


DESCRIPTION 


A  TAPE!  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LARR) 

(8)  Lighter  event  time  (LPSN) 

(9)  Lighter  event  time  (LRDY) 

(10)  Lighter  event  time  (LRDP) 

(11)  Lighter  in  position  time  (LPSN-LARR) 

(12)  Lighter  ready  time  (LRDY -LPSN) 

(13)  Lighter  at  crane  time  (LRDP-LPSN) 

(14)  Minutes  elapsed  from  the  beginning 
of  the  test. 

(1)  Facility  ID 

(2)  Julian  date 

3  Shift 

(4)  Lighter  type 

5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LARR) 

(8)  Lighter  event  time  (LPSN) 

(9)  Lighter  event  time  (LRDY) 

(10)  Lighter  event  time  (LRDP) 

(11)  Lighter  in  position  time  (LPSN-LARR) 

(12)  Lighter  ready  time  (LRDY-LPSN) 

(13)  Lighter  at  crane  time  (LRDP-LPSN) 

(14)  Minutes  elapsed  from  the  beginning 
of  the  test. 

(15)  Lighter  succession  time  (LRDY- 
previous  LRDP) 

(16)  Previous  lighter  type 

Contains  system  messages,  if  any. 


MAIN  PREV 


SUBROUTINE  CONVERT  (1) 
Purpose 


Converts  day,  shift,  hours  and  minutes  to  minutes  from  the  beginning 
of  the  test. 

Calling  Sequence 


CALL  CONVERT  (NOAV,  NSHIFT,  NHM,  MINS) 


Variable 

Type  Dimension 

Use 

Description 

NDAY 

Integer 

Input 

Julian  Date. 

NSHIFT 

Integer 

Input 

Shift  1  or  shift  2. 

NHM 

Integer 

Input 

Time  of  day  in  hours  and  minutes 
(military  time). 

MINS 

Integer 

Output 

Minutes  elapsed  from  the  beginning 
of  the  test. 

Common  Blocks 

Block  Name 

Input 

Output 

None 

None 

None 

Subroutines  Called 


FIGURE  3.10.  COMBINE  STRUCTURE 
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MAIN  PROGRAM  COMBINE 


Purpose 


To  combine  a  lighter  at  the  ship  record  with  a  lighter  at  the  shore 

record. 


Program  Statement 

PROGRAM  COMBINE  (SHIP,  SHORE,  0UTI3,  0UIC3,  0UTBN3,  OUTPUT) 


FILE  NAME  TYPE 


SHIP  Binary 


SHORE  Binary 


USE 

DESCRIPTION 

A  SHIP  record  contains 

Input 

(1)  Facility  ID 

(2)  Julian  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Forward  or  retrograde  (F/R) 

(9)  Lighter  event  time  (LRDY) 

(10)  Lighter  event  time  (LRDP) 

(11)  Lighter  at  ship  time  (LRDP-LRDY ) 

Input  A  SHORE  record  contains: 

(1)  Facility  ID 

(2)  Julian  Date 
3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  event  time  (LARR) 

(8)  Lighter  event  time  (LPSN) 

(9)  Lighter  event  time  (LRDY) 

(10)  Lighter  event  time  (LRDP) 

(11)  Lighter  in  position  time  (LPSN-LARR) 

(12)  Lighter  ready  time  (LRDY-LPSN) 

(13)  Lighter  at  crane  time  (LRDP-LRDY) 

(14)  Lighter  succession  time  (LRDY- 
previous  LRDP) 

(15)  Previous  Lighter  type 


FILE  NAME 


TYPE 


USE 


DESCRIPTION 


OUT  1 3 

OUTC3 


0UTBN3 

OUTPUT 


BCD 

Output 

Any  SHIP  or  SHORE  record  that 
have  a  matching  record  in  the 
file. 

doesn't 

other 

BCD 

Output 

' 1 )  Ship  facility  ID 
(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Forward  or  retrograde  (F/F) 

(9)  Lighter  ship  event  time  (LRDY) 

(10)  Lighrer  ship  event  time  (LRDP) 

(11)  Lighter  at  ship  time  (LRDP-LRDY) 

(12)  Shore  facility  ID 

(13)  Lighter  shore  event  time  (LARR) 

(141  Lighter  under  way  time 

(15)  Lighter  shore  event  time  (LPSN) 

(16)  Lighter  in  position  time  (LPSN-LARR) 

(17)  Lighter  shore  event  time  (LRDY) 

(18)  Lighter  ready  time  (LRDY-LSPN) 

(19)  Lighter  shore  event  time  (LRDP) 

(20)  Lighter  at  crane  time  (LRDP-LRDY) 

(21)  Lighter  succession  time 

(22)  Previous  lighter  type 


Binary 

Output 

Contains  the  same  record  as  0UTC3  plus 
minutes  elapsed  from  the  beginning  of 

the  test. 

BCD 

Output 

Contains  systems  messages,  if  any. 

MAIN  COMBINE 


SUBROUTINE  READ  (I) 
Purpose 


To  read  a  record  from  the  ship  and/or  shore  file. 

Calling  Sequence 

CALL  READ  (KODE,  NSHIP,  NSHORE,  NTIME1 ,  NTIME2,  NTIME3,  NEND) 


Variable 

KODE 

NSHIP 

Type 

Integer 

Integer 

Dimension 

2 

7 

Use 

Input 

Output 

NSHORE 

Integer 

6 

Output 

NTIME1 

Integer 

4 

Output 

NTIME2 

Integer 

7 

Output 

NTIME3 

Integer 

3 

Output 

Output 


Description 

(1)  Read  a  ship  record. 

(2)  Read  a  shore  record. 

Gives  lighter  at  the  ship  parameters: 

(1)  Facility  ID 

(2)  Julian  data 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

Gives  lighter  at  the  shore  parameters: 

1)  Facility  ID 

2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 
51  Lighter  ID 

6)  Lighter  cycle 

Gives  lighter  at  the  ship  parameters 

(1)  Forward  or  retrograde 

(2)  Lighter  event  time  (LRDY) 

(3)  Lighter  event  time  (LRDP) 

(4)  Lighter  at  ship  time  (LRDP-LRDY) 
Gives  lighter  at  the  shore  parameters: 

(1)  Lighter  event  time  (LARR) 

2)  Lighter  event  time  (LPSN) 

3)  Lighter  event  time  (LRDY) 

(4)  Lighter  event  time  (LRDP) 

(5)  Lighter  in  position  time  (LPSN-LARR) 

(6)  Lighter  ready  time  (LRDY-LPSN) 

(7)  Lighter  at  crane  time  (LRDP-LRDY) 

(1)  Lighter  underway  time 

(2)  Lighter  success  on  time 

(3)  Previous  lighter  type 

Equals  EOF  when  end-of-file  is  reached. 


NEND 


Integer 


2 


Common  Blocks 


Block  Name 
TBLUNIT 


Input 

NUNIT1,  NUNIT2,  NUNIT3, 
NUNIT4,  NUNIT5,  NUNIT6 


Output 

None 


Subroutines  Called 


MAIN  COMBINE 
SUBROUTINE  COMPARE  (2) 
Purpose 


To  determine  if  two  records  match  on  two  match  keys  (lighter  type  and 
lighter  identification). 


Calling  Sequence 


CALL  COMPARE  (Nl,  N2, 

N3,  N4, 

MATCH,  NFAIL1 ,  NFAIL  2} 

Variable 

Type 

Dimension 

Use 

Description 

Nl 

Integer 

- 

Input 

Lighter  type  at  the  ship. 

N2 

Integer 

- 

Input 

Lighter  ID  at  the  ship. 

N3 

Integer 

- 

Input 

Lighter  type  at  the  shore. 

N4 

Integer 

- 

Input 

Lighter  ID  at  the  shore. 

MATCH 

Logical 

- 

Output 

Match  equals  true  if  a  match  was  found. 
Match  equals  false  if  the  match  failed. 

NFAIL1 

Integer 

- 

Output 

Contains  the  NSHIP  match  key  where  the 
match  failed. 

NFAIL2 

Integer 

- 

Output 

Contains  the  NSHORE  match  key  where  the 
match  failed. 

Common  Blocks 

Block  Name 

Input 

Output 

None 

None 

None 

Subroutines 

Called 

None 


MAIN  COMBINE 


SUBROUTINE  SELECT  (3) 
Purpose 


To  determine  which  record  to  read. 
Calling  Sequence 

CALL  SELECT  (NFAIL1 ,  NFAIL2,  KODE) 


Variable 

Im. 

Dimension 

Use 

Description 

NFAIL1 

Integer 

- 

Input 

Contains  the  NSHIP  match 
the  match  failed. 

key  where 

NFAIL2 

Integer 

- 

Input 

Contains  the  NSHORE  match 
match  failed. 

key  where  the 

KODE 

Integer 

2 

Output 

(1)  Read  a  ship  record. 

(2)  Read  a  shore  record. 

Common  Blocks 

Block  Name 

Input 

Output 

None 

None 

None 

Subroutines 

Called 

MAIN  COMBINE 


SUBROUTINE  COMPUTE  (4) 
Purpose 


To  compute  lighter  succession  time  at  shore;  to  compute  lighter 
underway  time. 

Calling  Sequence 

CALL  COMPUTE  (NSHIP,  NSHORE,  NTIME1 ,  NTIME2,  NFWD,  NTIME3) 


Variable  Type  Dimension  Use 

NSHIP  Integer  7  Input 


NSHORE  Integer  6  Input 


NTIME1  Integer  4  Input 


NTIME2  Integer  7  Input 


NTIME3  Integer  3  Output 


Description 

Gives  lighter  at  the  ship  parameters: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

Gives  lighter  at  shore  the  parameters: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  time 

(5)  Lighter  ID 

(6)  Lighter  cycle 

Gives  lighter  at  the  ship  parameters: 

(1)  Forward  or  retrograde 

2)  Lighter  event  time  (LRDY) 

3)  Lighter  event  time  (LRDP) 

(4)  Lighter  at  ship  time  (LRDP-LRDY) 
Gives  lighter  at  the  shore  parameters: 

(1)  Lighter  event  time  (LARR) 

(2)  Lighter  event  time  (LPSN) 

(3)  Lighter  event  time  (LRDY) 

(4)  Lighter  event  time  (LRDP) 

(5)  Lighter  in  position  time  (LPSN-LARR) 

(6)  Lighter  ready  time  (LRDY-LPSN) 

(7)  Lighter  at  crane  time  (LRDP-LRDY) 

(1)  Lighter  underway  time 

(2)  Lighter  succession  time 

(3)  Previous  lighter  type 


MAIN  COMBINE 
SUBROUTINE  CONVERT  (4.1) 

Purpose 

To  convert  days,  shifts,  hours  and  minutes  into  minutes  from  the 
beginning  of  the  test. 

Calling  Sequence 

CALL  CONVERT  (NDAY,  NSHIFT,  NHM,  MINS) 


Variable 

Type 

Dimension 

Use 

Description 

NDAY 

Integer 

- 

Input 

Julian  date 

NSHIFT 

Integer 

- 

Input 

Shift 

NHM 

Integer 

- 

Input 

Time  of  day  in  hours  and  minutes 
(Military  time). 

MINS 

Integer 

- 

Output 

Minutes  elapsed  from  the  beginning 
of  the  test. 

Common  Blocks 

Block  Name 

Input 

Output 

None 

None 

None 

Subroutines 

Called 

MAIN  COMBINE 


SUBROUTINE  UPDATE  (5) 

Purpose 

To  save  either  a  ship  record  or  a  shore  record,  depending  on  the  value 

of  KODE. 

Calling  Sequence 

CALL  UPDATE  (KODE,  NSHIP,  LSHIP,  NSHORE,  LSHORE ,  NTIME1 ,  LTIME1 , 


NTIME2, 

LTIME2, 

Variable 

Type 

Dimension 

Use 

KODE 

Integer 

2 

Input 

NSHIP 

Integer 

7 

Input 

LSHIP 

Integer 

7 

Output 

NSHORE 

Integer 

6 

Input 

LSHORE 

Integer 

6 

Output 

NTIME1 

Integer 

4 

Output 

LTIME1 

Integer 

4 

Output 

NTIME2 

Integer 

7 

Output 

•> 


NTIME3,  LTIME3) 

Description 

(1)  K0DE(1)  =  1  save  a  ship  record 

(2)  KODE (2)  =  2  save  a  shore  record 

Gives  lighter  at  the  ship  parameters: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 
Same  as  NSHIP 

Gives  lighter  at  shore  the  parameters: 

(1 )  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  time 

(5)  Lighter  ID 

(6)  Lighter  cycle 

Same  as  NSHORE 

Gives  lighter  at  the  ship  parameters: 

(1)  Forward  or  retrograde 

(2)  Lighter  event  time  (LRDY) 

(3)  Lighter  event  time  (LRDP) 

(4)  Lighter  at  ship  time  (LRDP-LRDY) 

Same  as  LTIME 

Gives  lighter  at  the  shore  parameters: 

(1)  Lighter  event  time  (LARR) 

(2)  Lighter  event  time  (LPSN) 

(3)  Lighter  event  time  (LRDY) 

(4)  Lighter  event  time  (LRDP) 

(5)  Lighter  in  position  time  (LPSN-LARR) 

6)  Lighter  ready  time  (LRDY-LPSN) 

7)  Lighter  at  crane  time  (LRDP-LRDY) 
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NTIME3 

Integer 

3 

Input 

(1)  Lighter  underway  time 

(2)  Lighter  succession  time 

(3)  Previous  lighter  type 

LTIME3 

Integer 

3 

Output 

Common  Blocks 

Block  Name 

Input 

Output 

None 

None 

None 

Subroutines 

Called 

MAIN  COMBINE 


SUBROUTINE  RPTINC  (6) 
Purpose 


To  write  a  non-matching  record. 

Calling  Senuence 

CALL  RPTINC  (KQDE,  NSHIP,  NSHORE,  NTIME1 ,  NTIME2) 


Variable 

h ei 

Dimension 

Use  Description 

KODE 

Integer 

2 

Input  (1)  Write  a  ship  record 

(2)  Write  a  non-matching  shore  record 

NSHIP 

Integer 

7 

Input  Gives  lighter  at  the  ship  parameters: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

NSHORE 

Integer 

6 

Input  Gives  lighter  at  shore  the  parameters: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  time 

(5)  Lighter  ID 

(6)  Lighter  cycle 

NTIME1 

Integer 

4 

Input  Gives  lighter  at  the  ship  parameters: 

(1)  Forward  or  retrograde 

(2)  Lighter  event  time  (LRDY) 

(3)  Lighter  event  time  (LRDP) 

(4)  Lighter  at  ship  time  (LRDP-LRDY) 

NTIME2 

Integer 

7 

Input  Gives  lighter  at  the  shore  parameters: 

(1)  Lighter  event  time  (LARR) 

(2)  Lighter  event  time  (LPSN) 

(3)  Lighter  event  time  (LRDY) 

(4)  Lighter  event  time  (LRDP) 

(5)  Lighter  in  position  time  (LPSN-LARI 

(6)  Lighter  ready  time  (LRDY-LPSN) 

(7)  Lighter  at  crane  time  (LRDP-LRDY) 

Common  Blocks 


Block  Name  Input  Output 

TBLUNIT  NUNIT1 ,  NUNIT2,  NUNIT3,  None 

NUNIT4,  NUNIT5,  NUNIT6 


Subroutines  Called 


MAIN  COMBINE 


SUBROUTINE  RPTCOM  (7) 


Purpose 


To  write  a  combined  record  both  in  binary  and  BCD. 


Calling  Sec 

juence 

CALL  RPTCOM  (NSHIP, 

NSHORE, 

Variable 

Type 

Dimension 

Use 

NSHIP 

Integer 

7 

Input 

NSHORE 

Integer 

6 

Input 

NTIME1 

Integer 

4 

Input 

NTIME2 

Integer 

7 

Input 

NTIME3 

3 

Input 

NSORT 


Input 


Description 

Gives  lighter  at  the  ship  parameters: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

Gives  lighter  at  shore  the  parameters: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  time 

(5)  Lighter  ID 

(6)  Lighter  cycle 

Gives  lighter  at  the  ship  parameters: 

(1)  Forward  or  retrograde 

(2)  Lighter  event  time  (LRDY) 

(3)  Lighter  event  time  (LRDP) 

(4)  Lighter  at  ship  time  (LRDP-LRDY) 

Gives  lighter  at  the  shore  parameters: 

(1)  Lighter  event  time  (LARR) 

(2)  Lighter  event  time  (LPSN) 

(3)  Lighter  event  time  (LRDY) 

(4)  Lighter  event  time  (LRDP) 

(5)  Lighter  in  position  time  (LPSN-LARR) 

(6)  Lighter  ready  time  (LRDY-LPSN) 

(7)  Lighter  at  crane  time  (LRDP-LRDY) 

(1)  Lighter  underway  time 

(2)  Lighter  succession  time 

(3)  Previous  lighter  type 

Time  from  the  beginning  of  the  test  based 
on  LRDY  at  the  ship. 
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MAIN  COMBINE 
SUBROUTINE  STOP  (8) 

Purpose 

To  determine  if  EOF  is  in  any  file  or  in  all  files.  Sets  KQDE  to 


write  an  incomplete  record. 
Calling  Sequence 


CALL  STOP 

(NEND,  NSTOP 

,  NSTOP! 

Variable 

Jm. 

Dimension 

Use 

NEND 

Integer 

2 

Input 

NSTOP 

Logical 

- 

Output 

NST0P1 

Logical 

- 

Output 

KODE 

Integer 

2 

Output 

Common  Blocks 

Block  Name  Input 

None  None 


KODE) 

Description 

Equals  EOF  when  end  of  file  is  reached. 

When  NSTOP  is  false,  all  files  contain  data. 
When  NSTOP  is  true,  at  least  one  file  is 
out  of  data. 

When  NSTOP!  is  true,  all  files  are  out  of 
data. 

(1 )  Read  a  ship  file. 

(2)  Read  a  shore  file. 

Output 

None 


Subroutines  Called 


FIGURE  3.14.  WRTRPT  STRUCTURE 
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MAIN  PROGRAM  WRTRPT 
Purpose 


To  read  the  sorted  ship  to  shore  times  file,  compute  statistics  and 
write  report.  For  each  ship  facility,  date  and  shift,  statistics  are  accumulated 
on  individual  lighters  and  lighter  types. 

Program  Statement 

PROGRAM  WRTRPT  (TAPE1,  OUTPUT} 


FILE  NAME  TYPE  USE 


DESCRIPTION 


TAPE1 


Binary  Input 


(1)  Ship  Facility  ID 

(2)  Julian  date 
3)  Shift 

(4)  Lighter  type 

15)  Lighter  ID 
6)  Lighter  cycle 
7)  Lighter  position 
8)  Forward  or  retrograde  (F/R) 

9)  Lighter  ship  event  time  (LRDY) 

(10)  Lighter  ship  event  time  (LRDP) 

(11)  Lighter  at  ship  time  (LRDP-LRDY) 

(12  Shore  Facility  ID 

(13)  Lighter  shore  event  time  (LARR) 

(14)  Lighter  under  way  time 

(15)  Lighter  shore  event  time  (LPSN) 

(16)  Lighter  in  position  time  (LPSN-LARR) 
(17)  Lighter  shore  event  time  (LRDY) 

(18)  Lighter  ready  time  (LRDY-LPSN) 

(19)  Lighter  shore  event  time  (LRDP) 

(20)  Lighter  at  crane  time  (LRDP-LRDY) 

(21 )  Lighter  succession  time  (LRDY  - 
previous  LRDP) 

(22)  Previous  Lighter  type 


fl 
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MAIN  WRTRPT 
SUBROUTINE  ACC ID  (1) 
Purpose 


To  accumulate  individual  lighter  statistics 


Calling  Sequence 


CALL  ACCID  (SUMID,  SUMSQID,  NOID,  NSHIP,  NSHORE) 


VARIABLE 

TYPE 

DIMENSION  USE 

DESCRIPTION 

SUMID 

Real 

6  Input 

(1)  Sum  of  lighter  at  ship 

or 

times  (TLRDP-LRDY) 

Output 

(2)  Sum  of  lighter  under  way 

times 

(3)  Sum  of  lighter  in  position 
times  (ZLPSN-LARR) 

(4)  Sum  of  lighter  ready 
times  (ELRDY-LPSN) 

(5)  Sum  of  lighter  at  crane 
times  (ELRDP-LRDY) 

(6)  Sum  of  lighter  succession 
times 


SUMSQID 

Real 

6 

Input 

or 

Output 

(1)  -  (6)  Sums  of  squares  of 
the  same  6  items  as  above 

NOID 

Integer 

3 

Input 

or 

Output 

(1)  Number  of  lighter  under 
way,  lighter  In  position, 
lighter  ready,  and  lighter 
at  crane  times  Included 

In  sums 

(2)  Number  of  lighter  at  ship 
times  included  in  sums 

(3)  Number  of  lighter  succes¬ 
sion  times  included  in  sums 

NSHIP  Integer  11  Input  (1)  Ship  Facility  ID 

(2)  Julian  date 
3  Shift 

(4)  Lighter  type 

5)  Lighter  ID 

6)  Lighter  cycle 

7)  Lighter  position 

8)  Forward  or  retrograde  (F/R) 

9)  Lighter  ship  event  time  (LRDY) 

(10)  Lighter  ship  event  time  (LRDP) 

(11)  Lighter  at  ship  time  (LRDP- 
LRDY) 


$ 


kfl 
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VARIABLE  TYPE  DIMENSION  USE  DESCRIPTION 

NSHORE  Integer  11  Input  (1)  Shore  Facility  ID 

(2)  Lighter  shore  event  time 
(LARR) 

(3)  Lighter  under  way  time 

(4)  Lighter  shore  event  time 
(LPSN) 

(5)  Lighter  in  position  time 
(LPSN-LARR) 

(6)  Lighter  shore  event  time 
(LRDY) 

(7)  Lighter  ready  time  (LRDY- 

LPSN) 

(8)  Lighter  shore  event  time 
(LRDP) 

(9)  Lighter  at  crane  time 
(LRDP-LRDY) 

(10)  Lighter  succession  time 
(LRDY  -  previous  LRDP) 

(11)  Previous  lighter  type 

Commons  Blocks 
None 

Subroutines  Called 
None 


3-64 


MAIN  WRTRPT 
SUBROUTINE  ACCTY  (2) 
Purpose 


To  accumulate  lighter  type  statistics 


Calling  Sequence 


VARIABLE 


CALL  ACCTY  (SUMTY,  SUMSQTY ,  NOTYF,  NOTYR,  NSHIP,  NSHORE) 
TYPE  DIMENSION  USE  DESCRIPTION 


Input  (1,1)  Sum  of  forward  lighter 
or  at  ship  times 

Output  (2,1)  Sum  of  forward  lighter 

under  way  times 

(3.1)  Sum  of  forward  lighter 
in  position  times 

(4.1)  Sum  of  forward  lighter 
ready  times 

(5.1)  Sum  of  forward  lighter 
at  crane  times 

(6.1)  Sum  of  forward  lighter 
succession  times 

(1.2)  -  (6,2)  Sums  of  same  6 
times  as  above  except 
retrograde  Instead  of 
forward 

Input  Corresponding  sums  of  squares 

or  of  times  above 

Output 

Input  (1)  Number  of  forward  lighter 

or  under  way,  lighter  in  posi- 

Output  tion,  lighter  ready  and 

lighter  at  crane  times 
Included  In  "forward"  sums. 

(2)  Number  of  forward  lighter 
at  ship  times  Included 

in  "forward"  sums. 

(3)  Number  of  forward  lighter 
succession  times  Included 
In  "forward"  sums. 

Input  (1)  Number  of  retrograde  lighter 

or  under  way,  lighter  in  posi- 

Output  tion,  lighter  ready  and 

lighter  at  crane  times 
Included  in  "retrograde" 
sums. 

(2)  Number  of  retrograde  lighter 
at  ship  times  Included  in 
"retrograde"  sums. 
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MAIN  WRTRPT 

SUBROUTINE 

ACCTY  (2) 

(CONTINUED) 

VARIA8LE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

NSHIP 


Integer 


Input 


NSHORE 


Integer 


Input 


Number  of  retrograde 
lighter  succession  times 
Included  In  "retrograde" 
sums. 

Ship  Facility  ID 
Julian  date 
Shift 

Lighter  type 

Lighter  ID 

Lighter  cycle 

Lighter  position 

Forward  or  retrograde  ( F/R) 

Lighter  ship  event  time  (LRDY) 

Lighter  ship  event  time  (LRDP) 

Lighter  at  ship  time  (LRDP- 

LRDY) 

Shore  Facility  ID 
Lighter  shore  event  time 
(LARR) 

Lighter  under  way  time 
Lighter  shore  event  time 
(LPSN) 

Lighter  in  position  time 
(LPSN-LARR) 

Lighter  shore  event  time 
(LRDY) 

Lighter  ready  time  (LRDY- 
LPSN) 

Lighter  shore  event  time 
(LRDP) 

Lighter  at  crane  time 
(LRDP -LRDY) 

Lighter  succession  time 
(LRDY  -  previous  LRDP) 

Previous  lighter  type 


Common  Blocks 


Subroutines  Called 


To  Initialize  Individual  lighter  statistics  arrays 
Calling  Sequence 

CALL  INID  (SUMID,  SUMSQID,  NOID) 


VARIABLE 

DIMENSION 

DESCRIPTION 

SUMID 

Real 

6 

Output 

0) 

Sum  of  lighter  at  ship 

(2) 

times  (ZLRDP-LRDY) 

Sum  of  lighter  under  way 
times 

(3) 

Sum  of  lighter  in  position 

(4) 

times  (ZLPSN-LARR) 

Sum  of  lighter  ready 

(5) 

times  (ZLRDY-LPSN) 

Sum  of  lighter  at  crane 

(6) 

times  (ZLRDP-LRDY) 

Sum  of  lighter  succession 
times 

SUMSQID 

Real 

6 

Output 

0) 

-  (6)  Sums  of  squares  of 
the  same  6  items  as  above 

NOID 

Integer 

3 

Output 

(1) 

Number  of  lighter  under 
way,  lighter  in  position, 

lighter  ready,  and  lighter 
at  crane  times  Included 

In  sums 

(2) 

Number  of  lighter  at  ship 
times  Included  In  sums 

(3) 

Number  of  lighter  succes¬ 
sion  times  Included  in  sums 

Common  Blocks 


None 


Subroutines  Called 


MAIN  WRTRPT 


SUBROUTINE  INTY  (4) 

Purpose 

To  Initialize  lighter  type  statistics  arrays 
Calling  Sequence 

CALL  INTY  (SUMTY,  SUMSQTY,  NOTYF,  NOTYR) 


VARIABLE 


DIMENSION 


DESCRIPTION 


Output  (1,1)  Sum  of  forward  lighter 
at  ship  times 

(2.1)  Sum  of  forward  lighter 

under  way  times 

(3.1)  Sum  of  forward  lighter 
In  position  times 

(4.1)  Sum  of  forward  lighter 
ready  times 

(5.1)  Sum  of  forward  lighter 
at  crane  times 

(6.1)  Sum  of  forward  lighter 
succession  times 

(1.2)  -  (6,2)  Sums  of  same  6 

times  as  above  except 
retrograde  Instead  of 
forward 

Output  Corresponding  sums  of  squares 

of  times  above 

Output  (1)  number  of  forward  lighter 
under  way,  lighter  In  posi¬ 
tion,  lighter  ready  and 
lighter  at  crane  times 
included  In  "forward"  sums. 

(2)  Number  of  forward  lighter 
at  ship  times  included 

In  "forward"  sums. 

(3)  Number  of  forward  lighter 
succession  times  included 
in  "forward"  sums. 

Output  (1)  Number  of  retrograde  lighter 
under  way,  lighter  in  posi¬ 
tion,  lighter  ready  and 
lighter  at  crane  times 
included  In  "retrograde" 
sums. 

(2)  Number  of  retorgrade  lighter 
at  ship  times  included  In 
"retrograde"  suns. 
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SUBROUTINE  INTY  (4)  (CONTINUED) 
Coinnon  Blocks 


None 

Subroutines  Called 


None 
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MAIN  WRTRPT 
SUBROUTINE  PBRK  (5) 
Purpose 


To  write  a  new  page  heading  when  there  is  a  "break"  on  facility, 
date  or  shift.  In  addition,  calls  PRNTSY  to  print  lighter  type  statistics 
just  prior  to  the  heading  and  calls  PRNIND  to  print  the  first  individual 
lighter  record  after  the  heading. 

Calling  Sequence 

CALL  PGBRK  (FIRST,  OFAC,  OOATE,  OSHIFT,  NSHIP,  NSHORE,  KPGBR, 
OLTRTY ,  OLTRID,  OFR,  SUMID,  SUMSQIO,  SUMTY,  SUMSQTY,  NOID,  NOTYF,  NOTYR) 


VARIABLE 

DIMENSION 

DESCRIPTION 

FIRST 

Logical 

_ 

Input 

First  call  indicator 

OFAC 

Real 

- 

Output 

Current  Facility  ID 

ODATE 

Real 

- 

Output 

Current  date 

OSHIFT 

Real 

- 

Output 

Current  shift 

NSHIP 

Integer 

11 

Input 

(1)  Ship  Facility  ID 

NSHORE 


Integer 


11 


Input 


Julian  date 
Shift 

Lighter  type 
Lighter  ID 
Lighter  cycle 

(7)  Lighter  position 

(8)  Forward  or  retrograde  (F/R) 

(9)  Lighter  ship  event  time  (LRDY) 

(10)  Lighter  ship  event  time  (LRDP) 

(11)  Lighter  at  ship  time  (LRDP- 
LRDY) 

(11  Shore  Facility  ID 

(2)  Lighter  shore  event  time 
(LARR) 

(3)  Lighter  under  way  time 

(4)  Lighter  shore  event  time 
(LPSN) 

(5)  Lighter  In  position  time 
(LPSN-LARR) 

(6)  Lighter  shore  event  time 
(LARDY) 

(7)  Lighter  ready  time  (LRDY- 
LPSN) 

(8)  Lighter  shore  event  time 
(LRDP) 

(9)  Lighter  at  crane  time 
(LRDP-LRDY) 

(10)  Lighter  succession  time 
(LRDY-  previous  LRDP) 

(11)  Previous  lighter  type 
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MAIN  WRTRPT 

SUBROUTINE  PGBRK  (5)  (CONTINUED) 

VARIABLE  TYPE  DIMENSION 

KPGBR  Logical 

OLTRTY  Real 

OLTRID  Real 

OFR  Real 

SUMID  Real  6 


SUMSQID 

Real 

6 

SUMTY 

Real 

6,2 

SUMSQTY  Real  6,2 


USE  DESCRIPTION 

Output  Page  break  indicator 

Output  Current  lighter  type 

Output  Current  lighter  ID 

Output  Current  forward/retrograde 

indicator 

Input  (1)  Sum  of  lighter  at  ship  times 
(ILRDP-LRDY) 

(2)  Sum  of  lighter  under  way 
times 

(3)  Sum  of  lighter  in  position 
times  (ZLPSN-LARR) 

(4)  Sum  of  lighter  ready  times 
(ELRDY-LPSN) 

(5)  Sum  of  lighter  at  crane 
times  (ELRDP-LRDY) 

(6)  Sum  of  lighter  succession 
times 

Input  (1)  -  (6)  Sums  of  squares  of 
the  same  6  times  as  above. 

Input  (1,1)  Sum  of  forward  lighter 
at  ship  times 

(2.1)  Sum  of  forward  lighter 
under  way  times 

(3.1)  Sum  of  forward  lighter  in 
position  times 

(4.1)  Sum  of  forward  lighter 
ready  times 

(5.1)  Sum  of  forward  lighter 
at  crane  times 

(6.1)  Sum  of  forward  lighter 
succession  times 

(1.2)  -  (6,2)  Sums  of  same  6 
times  as  above  except  retro¬ 
grade  instead  of  forward 

Input  Corresponding  sums  of  squares 

of  times  above. 


MAIN  WRTRPT 

SUBROUTINE  PBGRK  (5)  (CONTINUED) 
VARIABLE  TYPE  DIMENSION 

NOID  Integer  3 


NOTYF  Integer  3 


NOTYR  Integer  3 


Common  Blacks 


USE  DESCRIPTION 

Input  (1)  Number  of  lighter  under 

way,  lighter  in  position, 
lighter  ready,  and  lighter 
at  crane  times  included  in  sums 

(2)  Number  of  lighter  at  ship 
times  included  in  sums. 

(3)  Number  of  lighter  successi 
times  included  in  sums. 

Input  (1)  Number  of  forward  lighter 

under  way,  lighter  In  posi 

lighter  ready  and  lighter 
at  crane  times  included  in 
"forward"  sums. 

(2)  Number  of  forward  lighter 
at  ship  times  included  in 
"forward"  sums. 

(3)  Number  of  forward  lighter 
succession  times  included 
In  "forward"  sums. 

Input  (1)  Number  of  retrograde 

lighter  under  way,  lighter 
in  position,  lighter  ready 
and  lighter  at  crane  times 
Included  in  "retrograde"  sums. 

(2)  Number  of  retrograde 
lighter  at  ship  times  included 
In  "retrograde"  sums. 

(3)  Number  of  retrograde 
lighter  succession  times 
included  In  "retrograde" 
sums. 


None 


Subroutines  Called 


MAIN  WRTRPT 
SUBROUTINE  PRNIND  (6) 
Purpose 


To  write  an  individual  lighter  ship  to  shore  record  (i.e.,  one  line 
in  the  report). 

Calling  Sequence 

CALL  PRNIND  (NSHIP,  NSHORE) 

VARIABLE  TYPE  DIMENSION  USE  DESCRIPTION 


NSHIP  Integer  11 


NSHORE  Integer  11 


Input 


Input 


(1 )  Facility  ID 

(2)  Julian  date 
(3  Shift 

(4)  Lighter  type 
(51  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Forward  or  retrograde  (F/R) 

(9)  Lighter  ship  event  time  (LRDY) 

(10)  Lighter  ship  event  time  (LRDP) 

(11)  Lighter  at  ship  time  (LRDP- 
LRDY) 

(1 )  Shore  Facility  ID 

(2)  Lighter  shore  event  time(LARR) 

(3)  Lighter  under  way  time 

(4)  Lighter  shore  event  time  (LPSN) 

(5)  Lighter  in  position  time  (LPSN- 
LARR) 

(6)  Lighter  shore  event  time  (LRDY) 

(7)  Lighter  ready  time  (LRDY-LPSN) 

(8)  Lighter  shore  event  time  (LRDP) 

(9)  Lighter  at  crane  time  (LRDP- 
LRDY) 

(10)  Lighter  succession  time  (LRDY- 
previcus  LRDP) 

(11)  Previous  lighter  type 


Common  Blocks 


None 


Subroutines  Called 


MAIN  WRTRPT 


SUBROUTINE  PRNIST  (7) 
Purpose 


To  compute  and  print  individual  lighter  statistics 
Calling  Sequence 

CALL  PRNIST  (SUMID,  SUMSQID,  NOID) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

SUMID 

Read 

6 

Input 

(1) 

(2) 

Sum  of  lighter  at  ship 
times  (ZLRDP-LRDY) 

Sum  of  lighter  under  way  times 

(3) 

Sum  of  lighter  in  position 

(4) 

times  (ILPSN-LARR) 

Sum  of  lighter  ready  times 

(5) 

(ELRDY-LPSN) 

Sum  of  lighter  at  crane 

(6) 

times  (ELRDP-LRDY) 

Sum  of  lighter  succession 
times. 

SUMSQID 

Real 

6 

Input 

0) 

-  (6)  Sums  of  squares  of 
the  same  6  times  as  above. 

NOID 

Integer 

3 

Input 

(1) 

Number  of  lighter  under  way, 
lighter  In  position, 
lighter  ready,  and  lighter 
at  crane  times  included  in  sums. 

(2) 

Number  of  lighter  at  ship 
times  included  in  sums. 

(3) 

Number  of  lighter  succession 

times  included  in  sums. 


Common  Blocks 


None 


Subroutines  Called 


MAIN  WRTRPT 


SUBROUTINE  PRNTST  (8) 
Purpose 


To  computer  and  print  lighter  type  statistics 


Calling  Sequence 


CALL  PRNTST  (SUMTY,  SUMSQTY ,  NOTYF,  NOTYR) 


VARIABLE 

SUMTY 


SUMSQTY 

NOTYF 


NOTYR 


TYPE  DIMENSION  USE  DESCRIPTION 

Real  6,2  Input  (1,1)  Sum  of  forward  lighter 

at  ship  times 

(2.1)  Sum  of  forward  lighter 
under  way  times 

(3.1)  Sum  of  forward  lighter 
in  position  times 

(4.1)  Sum  of  forward  lighter 
ready  times 

(5.1)  Sum  of  forward  lighter 
at  crane  times 

(6.1)  Sum  of  forward  lighter 
succession  times 

(1.2)  -  (6,2)  Sums  of  same  6 
times  as  above  except 
retrograde  instead  of  forward 

Real  6,2  Input  Corresponding  sums  of  squares 

of  times  above. 

Integer  3  Input  (1)  Number  of  forward  lighter 

under  way,  lighter  in  posi¬ 
tion,  lighter  ready  and 
lighter  at  crane  times 
included  in  "forward"  sums. 

(2)  Number  of  forward  lighter 
at  ship  times  included  in 
"forward"  sums. 

(3)  Number  of  forward  lighter 
succession  times  included 
in  "forward"  sums. 

Integer  3  Input  (1)  Number  of  retrograde  lighter 

under  way,  lighter  in  posi¬ 
tion,  lighter  ready  and 
lighter  at  crane  times 
included  in  "retrograde"  sums. 

(2)  Number  of  retrograde  lighter 
at  ship  times  included  In 
"retrograde"  sums. 

(3)  Number  of  retrograde  lighter 
succession  times  included 

in  "retrograde"  sums. 
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MAIN  WRTRPT 

SUBROUTINE  PRNTST  (8)  (CONTINUED) 
Common  Blocks 
None 

Subroutines  Called 


IV. 


LIGHTER  AND  CARGO  CYCLE  TIMES  PROGRAM 


INTRODUCTION 

The  Lighter  and  Cargo  Cycle  Times  Program  gives  times  relating  to 
the  interaction  of  lighters  and  their  cargo  at  the  ship  facilities.  For 
each  lighter  it  gives: 

1)  Lighter  type 

2)  Lighter  ID 

3)  Lighter  cycle  number 

4)  Lighter  position  at  the  ship 

5)  Direction  of  cargo  movement  (forward  or  retrograde) 

6)  Lighter  ready  at  the  ship  facility  (LRDY) 

7)  Lighter  ready  to  deport  the  ship 

8)  Lighter  at  the  ship  line  (LRDP-LRDY) 

9)  Lighter  succession  time  (LRDY-previous  LRDP) 

10)  Lighter  cycle  time  (LRDP-previous  LRDP) 

Data  for  the  cargo  on  each  lighter  includes: 

1)  Cargo  type 

2)  Cargo  ID 

3)  Crane  operator  ID 

4)  Lifting  device  over  container  time  (LDOC) 

5)  LDOC  -  previous  LDUN  (see  15  below  for  description  of  LDUN) 

6)  Lifting  device  lock  time  (LDLK) 

7)  LDLK-LDOC 

8)  Container  lifted  time  (LIFT) 

9)  LIFT-LDLK 

10)  Container  begin  position  time  (CPSN) 

11)  CPSN-LIFT 

12)  Container  land  time  (LAND) 
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13)  LAND-CPSN 

14)  Lifting  device  unlock  time  (LDUN) 

15)  LDUN-LAND 

16)  Delay  start,  if  any 

17)  Delay  type,  if  any 

The  number  of  samples,  mean,  and  standard  deviation  are  calculated  and  output 
for  all  time  differences.  The  output  data  is  arranged  by  facility  ID,  date, 
shift,  lighter  type,  lighter  ID,  direction  of  cargo  movement,  and  time. 

A  sample  output  is  given  in  Figure  4.1. 

PROGRAM  DESCRIPTION 

The  Lighter  and  Cargo  Cycles  program  consists  of  three  System  2000 
retrieval  programs,  seven  main  programs  and  37  subprograms,  six  sorts  and 
two  merges.  The  main  programs,  sorts  and  merges  are  combined  into  one  program 
by  control  statements.  A  flow  chart  of  the  individual  steps  is  given  in 
Figure  4.2. 

A  description  of  each  program  is  given  starting  with  the  three  System 
2000  retrieval  programs  and  followed  by  the  seven  main  programs.  The  descrip¬ 
tion  of  each  main  program  contains  a  structure  diagram,  a  flow  chart  of  the 
main  program  followed  by  a  write-up  of  each  main  program  and  its  subroutines. 


FIGURE  4.2.  FLOW  CHART  OF  THE  STEPS  IN  THE  LIGHTER  AND 
CARGO  CYCLE  TIMES  PROGRAM 


SYSTEM  2000  RETRIEVALS  FOR  THE  LIGHTER/CARGO  FILES 
Purpose 

To  retrieve  lighter/cargo  data  from  the  LOTS  system  2000  data  base 
and  to  store  the  data  on  two  files. 


FILE  NAME  TYPE  USE  DESCRIPTION 

UNITS  BCD  Output  (11  Facility  ID 

(2)  Julian  date 
3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Cargo  received  type 

(9)  Cargo  received  ID 

UNIT6  BCD  Output  (11  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(41  Lighter  type 
51  Lighter  ID 

6)  Lighter  cycle 

7)  Lighter  position 

8}  Cargo  discharged  type 
9)  Cargo  discharged  ID 


SYSTEM  2000  RETRIEVALS  FOR  THE  CARGO  TIMES  FILE 
Purpose 


To  retrieve  cargo  times  data  from  the  LOTS  System  2000  data  base  and 
to  store  the  data  on  two  files. 


FILE  NAME  TYPE  USE 


DESCRIPTION 


UNIT9A  BCD 


UNIT9B  BCD 


Output 


Output 


(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Crane  operator 

(5)  Receiving  carrier  type 

(6)  Receiving  carrier  ID 

(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  Cargo  event  name 

(10)  Cargo  event  time 

(11)  Delay  type 

(12)  Delay  category 

(13)  Delay  duration 

(1)  Facility  ID 

(2)  Julian  date 
;3)  Shift 

A)  Crane  operator 
5)  Discharging  carrier  type 

(6)  Discharging  carrier  type 

(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  Cargo  event  name 

(10)  Cargo  event  time 

(11)  Delay  type 

(12)  Delay  category 

(13)  Delay  duration 


ai  .Mil  fci  ail  fc.  -m£.  ,1iU  — ?  ~  ^  ^  “A 
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FIGURE  4.4.  MAIN  PROGRAM  (SHPGEN)  FLOW  DIAGRAM 
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MAIN  PROGRAM  SHPGEN 
Purpose 

To  combine  three  records,  contained  in  the  System  2000  ship  files,  into 
one  record. 

Program  Statement 

PROGRAM  SHPGEN  (LRDY1 ,  LRDP1 ,  FR1,  0UTI1,  0UTC1,  OUTPUT,  0UTBN1) 


FILE  NAME 
LRDY1 


Input 


LRDP1 


Input 


Input 


0UTI1 


Output 


DESCRIPTION 

A  LRDY1  record  contains: 

il)  Facility  ID 
2)  Julian  date 
3)  Shift 
41  Lighter  type 
51  Lighter  ID 
6)  Lighter  cycle 
7)  Lighter  position 
8)  Lighter  event  time  (LRDY) 

A  LRDP1  records  contains: 

(1)  Facility  ID 
2)  Julian  date 
3)  Shift 
41  Lighter  type 
51  Lighter  ID 
6)  Lighter  cycle 
7)  Lighter  event  time  (LRDP) 

A  NFR  record  contains: 

ill  Facility  ID 
2)  Julian  date 
3)  Shift 
41  Lighter  type 
5)  Lighter  ID 
6)  Lighter  cycle 
7)  Foreward  or  retrograde  (F/R) 

Any  LRDY1,  LRDP2  or  NFR  record  that 
doesn't  have  matching  records  in  the 
other  two  files. 
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DESCRIPTION 


A  OUTC1  record  contains: 

H)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  iD 

(6)  Lighter  cycle 

(71  Lighter  position 

(8)  Forward  or  retrograde  (F/R) 

(9)  Lighter  event  time  (LRDY) 

(10)  Lighter  event  time  (LRDP) 

(11)  Lighter  Ship  time  (LRDP-LRDY) 

(12)  Minutes  elapsed  from  the  beginning 
of  the  test. 


Contains  system  messages,  if  any. 
Contains  the  same  record  as  0UTC1. 


MAIN  SHPGEN 


SUBROUTINE  READ  (1) 

Purpose 

To  read  one  record  from  one,  two  or  three  input  files  depending  on 
the  value  of  KODE. 


Calling  Sequence 

CALL  READ  {KODE,  NLRDY,  NLRDP,  NFR,  NLGTPS,  NPAM,  NFIRST,  NEND) 


Variable 

Dimension 

Use 

Description 

KODE 

Integer 

3 

Input 

(1)  Flag  to  read  a  file  1  record. 

(2)  Flag  to  read  a  file  2  record. 

(3)  Flag  to  read  a  file  3  record. 

NFIRST 

Logical 

- 

Input 

Equals  false  on  first  call  and  true 
on  additional  calls. 

NLRDY 

Integer 

6 

Output 

First  six  parameters  of  input  file 

1  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

NLRDP 

Integer 

6 

Output 

First  six  parameters  of  input  file 

2  record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

NFR 

Integer 

6 

Output 

First  six  parameters  of  input  file 

3  record,  i.e. , 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

NLGTPS 

Integer 

— 

Output 

Seventh  parameter  of  input  file  1 
record ; i .e. ,  lighter  position. 

NPAM 

Integer 

3 

Output 

Last  parameter  of  each  of  the  three 
input  file  records,  i.e., 

(1)  File  1  record-lighter  event  time 
(LRDY) 

(2)  File  2  record-lighter  event  time 
(LRDY) 

(3)  File  3  record-foreward  or  retro¬ 
grade  movement  (F/R) 

Output  Equals  EOF  when  end-of-file  is  reached. 


NEND 


Integer 


3 


MAIN  SHPGEN 

SUBROUTINE  COMPARE  (2) 

Purpose 

To  determine  if  two  records  match  on  six  match  keys.  If  there  is 


no  match, 
failed. 

it  returns 

to  the  main 

program 

Calling  Sequence 

CALL  COMPARE  (NTEST1, 

NTEST2, 

Variable 

NTEST1 

Jm. 

Integer 

Dimension 

6 

Use 

Input 

NTEST2 

Integer 

6 

Input 

MATCH 

Logical 

- 

Input 

NFAILI 

Integer 

- 

Output 

NFAIL2 

Integer 

- 

Output 

Common  Blocks 

Block  Name 

None 

Inputs 

None 

Subroutines  Called 

None 


the  first  match  key  where  the  match 


MATCH,  NFAIL1,  NFAIL2) 

Description 

Contains  the  lighter  ready  record 
(six  match  keys). 

Contains  the  lighter  ready  to  depart 
or  foreward/retrograde  record  (six 
match  keys). 

MATCH  equals  true  if  a  match  was 
found.  MATCH  equals  false  if  the 
match  failed. 

Contains  the  first  lighter  ready 
match  key  where  the  match  failed. 
Contains  the  first  lighter  ready  or 
the  first  foreward/retrograde  match 
key  where  the  match  failed. 


Output 

None 
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MAIN  SHPGEN 


SUBROUTINE  SELECT  (3) 

Purpose 

To  determine  which  record  to  read. 

Calling  Sequence 

CALL  SELECT  (KEY,  NFAIL1,  NFAIL2,  KODE) 
Variable  Type  Dimension  Use  Description 


KEY 

Integer 

Input 

NFAIL1 

Integer 

Input 

NFAIL2 

Integer 

- 

Input 

KODE 

Integer 

3 

Output 

Common  Blocks 

Block  Name  Input 

None  None 

Subroutines  Called 
None 


When  KEY  equals  1,  the  match  between 
a  lighter  ready  record  and  a  lighter 
ready  to  depart  record  failed.  When 
KEY  equals  2,  the  match  between  a 
lighter  ready  record  and  a  forward/ 
retrograde  record  failed. 

Contains  the  first  lighter  ready 
match  key  where  the  match  failed. 
Contains  the  first  lighter  ready 
or  the  first  foreward/retrograde 
match  key  where  the  match  failed. 

If  match  failed: 

(1)  Flag  to  indicate  an  incomplete 
file  1  record. 

(2)  Flag  to  indicate  an  incomplete 
file  2  record. 

(3)  Flag  to  indicate  an  incomplete 
file  3  record. 


Output 

None 
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MAIN  SHPGEN 

SUBROUTINE  CONVERT  (4) 

Purpose 

Converts  day,  shift,  hours,  and  minutes  to  minutes  from  the  beginning 
of  the  test. 

Calling  Sequence 

CALL  CONVERT  (NDAY,  NSHIFT,  NHM,  MINS) 


Variable 

1X21 

Dimension  Use 

Description 

NDAY 

Integer 

Input 

Julian  date. 

NSHIFT 

Integer 

Input 

Shift  1  or  shift  2. 

NHM 

Integer 

Input 

Time  of  day  in  hours  and  minutes 
(military  time). 

MINS 

Integer 

Output 

Minutes  elapsed  from  the  beginning 
of  the  test. 

Common  Blocks 

Block  Name  Input 

None  None 

Subroutines  Called 
None 


Output 

None 
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MAIN  SHPGEN 


SUBROUTINE  RPTINC  (5) 
Purpose 


To  write  an  incomplete  record. 

Calling  Sequence 

CALL  RPTINC  (KODE,  NLRDY,  NLRDP,  NFR,  NLGTPS,  NPAM,  NFINC) 


Variable 

KODE 

Im. 

Integer 

Dimension 

3 

Use 

Input 

• 

NLRDY 

Integer 

6 

Input 

NLRDP 

Integer 

6 

Input 

NFR 

Integer 

6 

Input 

NLGTPS 

Integer 

Input 

NPAM 

Integer 

3 

Input 

NFINC 

Logical 

Input 

Description 

(1)  Flag  to  write  a  file  1  record. 

2)  Flag  to  write  a  file  2  record. 

3)  Flag  to  write  a  file  3  record. 

First  six  parameters  of  input  file  1 
record,  i.e., 

(1)  Facility  ID 

(2)  Date 

3)  Shift 

4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

First  six  parameters  of  input  file  2 
record,  i.e., 

1)  Facility  ID 

2)  Date 

(3)  Shift 

54)  Lighter  type 

5)  Lighter  ID 

6)  Lighter  cycle 

First  six  parameters  of  input  file  3 
record,  i.e., 

(1)  Facility  ID 

(2)  Date 

(3)  Shift 

4)  Lighter  type 

5)  Lighter  ID 
(6)  Lighter  cycle 
Seventh  parameter  of  input  file  1 
record,  i.e.,  lighter  position. 

Last  parameter  of  each  of  the  three 
input  file  records,  i.e., 

(1)  File  1  record-lighter  event  time 
(LRDY) 

(2)  File  2  record-lighter  event  time 
LRDY) 

3)  File  3  record-forward  or  retro¬ 
grade  movement  (F/R) 

Equals  false  on  first  call  and  true 
on  additional  calls.  When  NFINC  equals 
false,  automatically  prints  complete 
record  file  title. 


MAIN  StIPGEN 
SUBROUTINE  RPTCOM  (6) 

Purpose 

To  write  a  complete  record. 

Calling  Sequence 

CALL  RPTCOM  (NLRDY,  NLGTPS,  NPAM,  NFCOM,  LSHPT,  MINS) 


Variable 

Type 

Dimension  Use 

NLRDY 

Integer 

6  Input 

NLGTPS 

Integer 

- 

Input 

NPAM 

Integer 

3 

Input 

NFCOM 

Logical 

Input 

LSHPT 

MINS 

Integer 

Integer 

Input 

Input 

Common  Blocks 

Block  Name 

Input 

TBLUNIT 

NUNIT5,  NUNIT7 

Description 

First  six  parameters  of  input  file  1 
record,  i.e., 

(1)  Facility  ID 
2)  Date 

(3)  Shift 

(4)  Lighter  type. 

(5)  Lighter  ID 

(6)  Lighter  cycle 

Seventh  parameter  of  input  file  1 
record,  i.e.,  lighter  position. 

Last  parameter  of  each  of  the  three 
input  file  records,  i.e., 

(1)  File  1  record-lighter  event  time 
(LRDY) 

(2)  File  2  record-lighter  event  time 
(LRDY) 

(3)  File  3  record- forward  or  retro¬ 
grade  movement  (F/R). 

Equals  false  on  first  call  and  true 
on  additional  calls.  When  NFCOM 
equals  false,  automatically  prints 
complete  record  file  title. 

Lighter  at  ship  time  (LRDP-LRDY). 
Minutes  elapsed  from  the  beginning 
of  the  test. 


Output 

None 


Subrouti nes  Called 


MAIN  SHPGEN 
SUBROUTINE  STOP  (7) 


Purpose 

To  determine  if  end-of-file  is 
to  write  incomplete  records. 

Calling  Sequence 

CALL  STOP  (NEND,  NSTOP,  NST0P1, 


Variable 

Type 

Dimension 

Use 

NEND 

Integer 

3 

Input 

NSTOP 

Integer 

** 

Output 

NSTOP 1 

Logical 

- 

Output 

KODE 

Integer 

3 

Output 

Common  Blocks 

Block  Name  Input 

None  None 

Subroutines  Called 


in  any  or  in  all  files.  Sets  KODE 


KODE) 

Description 

Equals  EOF  when  end  of  file  is  reached. 
When  NSTOP  is  false,  all  files  contain 
data.  When  NSTOP  is  true,  at  least 
one  file  is  out  of  data. 

When  NST0P1  is  true,  all  files  are 
out  of  data. 

(1)  Flag  to  read  a  file  1  record. 

(2)  Flag  to  read  a  file  2  record. 

(3)  Flag  to  read  a  file  3  record. 


Output 

None 


MAIN  PROGRAM  PREV 


Purpose 


To  save  previous  LRDP  on  present  lighter  at  ship  record,  and  to  compute 
lighter  succession  time  and  lighter  at  ship  cycle  time. 

Program  Statement 

PROGRAM  PREV  (TAPE!,  OUT,  OUTPUT) 


FILE  NAME  TYPE  USE 


DESCRIPTION 


TAPE!  Binary  Input 


OUT  Binary  Output 


OUTPUT  BCD  Output 


A  TAPE1  record  contains: 

(1 )  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction  (F/R) 

(9)  LRDY 

(10)  LRDP 

(11)  Lighter  at  ship  time  (LRDY-LRDP) 

(12)  Minutes  elapsed  from  the  beginning 
of  the  test. 

An  OUT  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 
3  Shift 

(4)  Lighter  type 
5  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction  (F/R) 

(9)  LRDY 
(10  LRDP 

(11 )  Lighter  at  ship  time  (LRDY-LRDP) 

(12)  Lighter  succession  time  (LRDY- 
previous  LRDP) 

(13)  Lighter  at  ship  cycle  time  (LRDP- 
prevlous  LRDP) 

An  OUTPUT  record  contains  the  same 
parameters  as  the  OUT  record  contains. 


MAIN  PREV 

SUBROUTINE  CONVERT  (1) 


Purpose 

Converts  day,  shift,  hours, 
of  the  test. 


Calling  Sequence 

CALL  CONVERT  (NDAY,  N SHI  FT, 

Variable 

Dimension  Use 

NDAY 

Integer 

Input 

NSHIFT 

Integer 

Input 

NHM 

Integer 

Input 

MINS 

Integer 

Output 

Common  Blocks 

Block  Name 

Input 

None 

None 

and  minutes  to  minutes  from  the  beginning 

MUM,  MIMS) 

Description 

Julian  date. 

Shift  1  or  shift  2. 

Time  of  day  in  hours  and  minutes 
(military  time). 

Minutes  elapsed  from  the  beginning 
of  the  test. 

Output 
Hone 


Subroutines  Called 
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FIGURE  4.8.  PROGRAM  (STEP8)  FLOW  DIAGRAM 


MAIN  PROGRAM  STEPS 


Purpose 


To  add  cargo  type  and  cargo  ID  to  lighter  records. 


Program  Statement 


PROGRAM  STEP8  (UNIT4,  UNIT7,  0UTI7,  OUTCT,  UNIT8,  OUTPUT) 


FILE  NAME  TYPE 


UNIT4 


Binary 


Input 


UNIT7 


Input 


OUT  1 7 
0UTC7 


Output 

Output 


DESCRIPTION 

An  UNIT4  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 
3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction 

(9)  LRDY 

(10)  LRDP 

(11)  Lighter  at  ship  time  (LRDY-LRDP) 

(12)  Lighter  succession  time  (LRDY- 
previous  LRDP) 

(13)  Lighter  at  ship  cycle  time  (LRDP- 
previous  LRDP) 

An  UNIT7  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Cargo  type 

(9)  Cargo  ID 

0UTI7  contains  a  non-matching  UNIT7  or 
UNIT4  record. 

A  0UTC7  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 
(3  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction  (F/R) 

(9  LRDY 

(10)  LRDP 

(11)  Lighter  at  ship  time  (LRDY-LRDP) 
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FILE  NAME 


0UTC7  (Cont'd) 


UNIT8 

OUTPUT 


Binary 


Output 

Output 


DESCRIPTION 


(12)  Lighter  succession  time  (LRDY- 
previous  LRDP) 

(13)  Lighter  at  ship  cycle  time 
(LRDP-previous  LRDP) 

(14)  Cargo  type 

(15)  Cargo  ID 

An  UNIT8  record  contains  the  same 
paramaters  as  the  above  0UTC7  record 
Contains  systems  messages,  if  any. 


MAIN  STEP8 
SUBROUTINE  READ  (1) 
Purpose 


To  read  a  record  from  the  lighter  times  file  and/or  the  cargo  ID  file. 
Calling  Sequence 

CALL  READ  (KODE,  LIGHTER,  NCARGO,  NEND) 


VARIALBE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

KODE 

Integer 

2 

Input 

(1)  Flag  to  read  a 

(2)  Flag  to  read  a 

file  1 
file  2 

LIGHTER 

Integer 

13 

Output 

(1)  Facility  ID 

(2) 

(3) 


Julian 

Shift 


date 


record 

record 


NCARGO  Integer  9 


NEND  Integer  2 


Output 


Output 


(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction 

(9)  Lighter  ready  time  (LRDY) 

(10)  Lighter  ready  to  depart 

time  (LRDP) 

(11)  Lighter  in  position  time 
(LRDP-LRDY) 

(12)  Lighter  succession  time 
(LRDY-previous  LRDY) 

(13)  Lighter  at  ship  cycle  time 
(LRDP-prevlous  LRDP) 

(1)  Facility  ID 

(2)  Julian  date 
3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Cargo  type 

(9)  Cargo  ID 

Equals  EOF  wnei  end-of-file 
is  reached. 


Common  Blocks 


Block  Name  Inputs  Output 

TBLUNIT  NUNIT1 ,  NUNIT2,  NONE 

NUNIT3,  NUNIT4, 

NUNIT5,  NUNIT6 

Subroutines  Called 
None 
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MAIN  STEP8 

SUBROUTINE  COMPARE  (2) 

Purpose 

To  determine  if  two  records  match  on  six  match  keys.  If  no  match,  it 
returns  to  the  main  program  the  first  key  where  the  match  failed. 

Calling  Sequence 

CALL  COMPARE  (NTEST1 ,  NTEST2,  MATCH,  NFAIL1 ,  NFAIL2) 


VARIABLE  TYPE  DIMENSION  USE  DESCRIPTION 

NTEST1  Integer  13  Input  (1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction 

(9)  Lighter  ready  time  (LRDY) 

(10)  Lighter  ready  to  depart  time 

(LRDP) 

(11)  Lighter  in  position  time 
(LRDP-LRDY) 

(12)  Lighter  succession  time 
(LRDY-previous  LRDY) 

(13)  Lighter  at  ship  cycle  time 
(LRDP-previous  LRDP) 

NTEST2  Integer  9  Input  (1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

14)  Lighter  type 

5)  Lighter  ID 

6)  Lighter  cycle 

7)  Lighter  position 

8)  Cargo  type 
(9)  Cargo  ID 

MATCH  Logical  -  Output  MATCH  equals  true  if  a  match 

was  found.  MATCH  equals  false 
if  the  match  failed. 


MAIN  STEP8 

SUBROUTINE  COMPARE  (2)  (CONTINUED) 


VARIABLE 


DIMENSION 


DESCRIPTION 


NFAIL1 

Integer 

Output 

Contains  the  first  LIGHTER 
match  key  where  the  match 
failed. 

NFAIL2 

Integer 

Output 

Contains  the  first  NCARGO 
match  key  where  the  match 
failed. 

Common  Blocks 

Block  Name 

Input 

Output 

NONE 

NONE 

Subroutines  Called 

[•] 


MAIN  STEP8 


SUBROUTINE  SELECT  (3) 

Purpose 

To  determine  which  file  to  read 
Calling  Sequence 

CALL  SELECT  (NFAIL1 ,  NFAIL2,  KODE) 


VARIABLE 


DIMENSION 


DESCRIPTION 


NFAIL1 

Integer 

Input 

Contains  the  first  LIGHTER 
match  key  where  the  match 
failed. 

NFAIL2 

Integer 

Input 

Contains  th"  first  NCARGO 
match  key  where  the  match 
failed. 

KODE 

Integer 

2 

Output 

(1)  Flag  to  read  a  file  1  record. 

(2)  Flag  to  read  a  file  2  record. 

Common  Blocks 

Block  Name 

Input 

Output 

NONE 

NONE 

NONE 

Subroutines  Called 

MAIN  STEP  8 
SUBROUTINE  RPTINC  (4) 


Subroutines  Called 


LIGHTER 


Integer 


Input 


NCARGO 


Integer 


Input 


NPRINT 


Logical 


Input/ 

Output 


Common  Blocks 
Block  Name 
NBLUNIT 

Subroutines  Called 


Input 


NUNIT1,  NUNIT2 
NUNIT3,  NUNIT4, 
NUNIT5,  NUNIT6 


(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction 

(9)  Lighrer  ready  time  (LRDY) 

(10)  Lighter  ready  to  depart 

time  (LRDP) 

(11)  Lighter  in  position  time 
(LRDP-LRDY) 

(12)  Lighter  succession  time 
(LRDY-previous  LRDY) 

(13)  Lighter  at  ship  cycle 
time  (LRDP-previous  LRDP) 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Cargo  type 

(9)  Cargo  ID 

If  NPRINT  equals  false  writes 
a  complete  record;  if  true,  the 
present  lighter  record  is 
complete. 


Output 

NONE 


MAIN  STEP  8 
SUBROUTINE  STOP  (6) 

Purpose 

To  determine  if  EOF  in  any  file  or  if  EOF  in  all  files.  Sets  KODE 
to  indicate  which  records  to  read. 


Calling  Sequence 


CALL 

STOP  (NEND, 

NSTOP,  NST0P1 , 

KODE) 

VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

NEND 

Integer 

2 

Input 

Equals  EOF  when  end  of  file 
is  reached. 

NSTOP 

Logical 

Output 

When  NSTOP  is  false,  all  files 
contain  data.  When  NSTOP  is 
true,  at  least  one  file  is  out 
of  data. 

NST0P1 

Logical 

- 

Output 

When  NST0P1  is  true  all  files 
are  out  of  data. 

KODE 

Integer 

2 

Output 

(1)  Flag  to  read  a  file  1  record. 

(2)  Flag  to  read  a  file  2  record. 

Common  Blocks 

Block  Name 

Input 

Output 

NONE 

NONE 

NONE 

Subroutines  Called 
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MAIN  PROGRAM  CARGO  ID 


Purpose 


To  construct  one  record  which  contains  LDOC,  LDLK,  LIFT,  CPSN,  LAND, 
LDUN,  Delay  start  and  delay  type. 

Program  Statement 

PROGRAM  CARGO ID  (CARGO,  0UTI1 ,  OUTC1 ,  UNIT! 1 ,  OUTPUT) 


FILE  NAME  TYPE  USE 

CARGO  BCD  Input 


OUT  11 

BCD 

Output 

0UTC1 

BCD 

Output 

DESCRIPTION 

A  CARGO  record  contains: 

(1 )  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  Cargo  event  name 

(10)  Cargo  event  time 

(11)  Delay  type 

(12)  Delay  category 

(13)  Delay  duration 

Outputs  records  that  are  missing  one 
or  more  of  the  following:  LDOC,  LDLK, 
LIFT,  CPSN,  LAND,  LDUN. 

An  0UTC1  record  contains: 

1)  Facility  ID 

2)  Julian  date 

(3)  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  LDOC 

10)  LDLK 

11)  LIFT 

12)  CPSN 

13)  LAND 

(14)  LDUN 

(15)  Delay  start 

(16)  Delay  type 

17)  Delay  sequence  number 

18)  Minutes  elapsed  from  the  start  of 
the  test. 
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MAIN  PROGRAM  CARGO ID  (CONTINUED) 


FILE  NAME 
UNIT! 1 


TYPE 

USE 

DESCRIPTION 

Binary 

Output 

An  UNIT1I  record  contains  the 
parameters  as  the  above  OUTC1 

same 

record. 

BCD 

Output 

Contains  systems  messages,  if 

any. 

OUTPUT 


MAIN  CARGO  ID 
SUBROUTINE  READ  (1) 


Purpose 


To  read  one  input  record. 
Calling  Sequence 
CALL  READ  (NDATA,  STOP) 


VARIABLE 


NDATA 


Integer 


Logical 


DIMENSION  USE  DESCRIPTION 


13  Output  (1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  Cargo  event  name 

(10)  Cargo  event  time 

(11)  Delay  type 

(12)  Delay  category 

(13)  Delay  duration 

Output  When  STOP  equals  true,  at 

least  one  file  is  out  of  data. 
When  STOP  equals  false,  all 
files  contain  dara. 


Common  Blocks 


Block  Name 


TBLUNIT 

NUNIT1 , 

NUNIT2 

Subroutines  Called 

NUNIT3, 

NUNIT4 

MAIN  CARGO  ID 
SUBROUTINE  CHANGE  (2) 
Purpose 


To  set  the  value  of  END  to  true  when  the  facility  ID,  Lighter  type.  Lighter  ID, 
cargo  ID,  or  cargo  cycle  change. 

Calling  Sequence 

CALL  CHANGE  (NDATA,  FIRST,  END) 

VARIABLE  TYPE  DIMENSION  USE  DESCRIPTION 


NDATA 

Integer 

13 

Input 

(1)  Facility  ID 

(2)  Julian  data 

3  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  Cargo  event  name 

(10)  Cargo  event  time 

(11)  Delay  type 

(12)  Delay  category 

(13)  Delay  duration 

FIRST 

Logical 

Input/ 

Output 

Equals  true  on  first  call  for 
each  cargo  ID.  Equals  false 
on  additional  calls  for  the 
same  cargo  ID. 

END 

Coninon  Blocks 

Logical 

Output 

Flag  to  indicate  a  change  iri 
facility  ID,  Lighter  type. 
Lighter  ID;  cargo  ID  or  cargo 
cycle  change. 

Block  Name 


Input 


Output 


NONE 


NONE 


NONE 


Subroutines  Called 


MAIN  CARGO  I D 
SUBROUTINE  BUILD  (3) 
Purpose 


To  construct  a  record  which  contains  the  LDOC,  LLLK,  LIFT,  CPSN,  LAND,  and 
the  DUN,  Also  constructs  NDELAY  record(s)  which  contain  delay  time,  type,  and 
duration.  Sets  a  flag  to  indicate  if  the  record  is  complete. 


Calling  Sequence 

CALL  BUILD  (NDATA,  FIRST,  NPAM,  NDELAY 1 ,  NDELAY2,  NSEQ,  FLAG,  NSAVE) 


VARIABLE  TYPE 


DIMENSION  USE  DESCRIPTION 


NDATA  Integer  13 


FIRST  Logical 


NPAM  Integer  6 


NDELAY 1  Integer  20 

NDELAY 2  Integer  20 

NSEQ  Integer 

FLAG  Logical 


Input 


Input/ 

Output 


Output 


Output 

Output 

Output 

Output 


(1)  Facility  ID 

iZ)  Julian  data 
3  Shift 
4)  Operator  ID 
5;  Lighter  type 
(6)  Lighter  ID 
(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  Cargo  event  name 

(10)  Cargo  event  time 

(11)  Delay  type 

(12)  Delay  category 

(13)  Delay  duration 

Equals  true  on  first  call  in 
each  cargo  ID,  Equal,  false  on 
additional  calls  for  the  same 
cargo  ID. 

(1)  Cargo  event  time  (LDOC) 

(2)  Cargo  event  time  (LDLK) 

(3)  Cargo  event  time  (LIFT) 

(4)  Cargo  event  time  ( CPSN ) 

(5)  Cargo  event  time  (LAND) 

(6)  Cargo  event  time  (LDUN) 

Delay  event  time. 

Delay  event  type. 

Number  of  delays. 

Equals  true. when  a  record  is 
complete.  Equals  false  when 
a  record  is  incomplete. 
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MAIN  CARGO ID 


SUBROUTINE  BUILD  (3)  CONTINUED 

DESCRIPTION 

(1)  Facility  ID 

(2)  Julian  data 

(3)  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 

(8)  Cargo  cycle 

Common  Blocks 

Block  Name  Input  Output 

NONE  NONE  NONE 

Subroutines  Called 
NONE 


VARIABLE  TYPE  DIMENSION  USE 

NSAVE  Integer  8  Output 
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MAIN  CARGO  ID 


SUBROUTINE  CONVERT  (4) 

Purpose 

Converts  days,  shifts,  hours  and  minutes  to  minutes  from  the  beginning  of  the 
test. 

Calling  Sequence 

CALL  CONVERT  (NDAY,  NSHIFT,  NHM,  MINS) 


VARIABLE 


DIMENSION 


DESCRIPTION 


NDAY 

Integer 

- 

Input 

Julian  date 

NSHIFT 

Integer 

- 

Input 

Shift  1  or  shift  2 

NHM 

Integer 

Input 

Time  of  day  in  hours  and  minutes 
(military  time). 

MINS 

Integer 

Output 

Minutes  elapsed  from  the 
beginning  of  the  test. 

Common  Blocks 

Block  Name 

Input 

Output 

NONE 

NONE 

NONE 

Subroutines  Called 

[i 


MAIN  CARGO ID 
SUBROUTINE  RPTINC  (5) 

Purpose 

To  write  an  incomplete  record. 

Calling  Sequence 

CALL  RPTINC  (NDATA,  NPAM,  NSEQ,  NDELAY1 ,  NDELAY2) 


VARIABLE 


DIMENSION 


DESCRIPTION 


NDATA 

Integer 

8 

Input 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 
(8;  Cargo  cycle 

NPAM 

Integer 

6 

Input 

(1)  Cargo  event  time  (LDOC) 

(2)  Cargo  event  time  (LDLK) 

(3)  Cargo  event  time  (LIFT) 

(4)  Cargo  event  time  (CPSN) 

(5)  Cargo  event  time  (LAND) 

(6)  Cargo  event  time  ( LOUN ) 

NSEQ 

Integer 

- 

Input 

Number  of  Delays. 

NDELAY1 

Integer 

20 

Input 

Delay  event  time. 

NDELAY2 

Common  Blocks 

Block  Name 

Integer 

20 

Input 

Input 

Delay  event  type. 

Output 

TBLUNIT 

NUNIT1 , 

NUNIT2 

Subroutines  Called 

NUNIT3, 

NUNIT4 

T 


MAIN  CARGO  ID 
SUBROUTINE  RPTCOM  (6) 
Purpose 


To  write  a  complete  record. 

Calling  Sequence 

CALL  RPTCOM  (NDATA,  NPAM,  NSEQ,  NDELAY1 ,  NDELAY2,  NTIME) 


VARIABLE 


NDATA 


NSEQ 

NDELAY1 

NDELAY2 

NTIME 


Integer 


Integer 


DIMENSION 


Input 


Input 


DESCRIPTION 


(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 
(8;  Cargo  cycle 

(1)  Cargo  event  time  (LDOC) 

(2)  Cargo  event  time  (LDLK) 

(3)  Cargo  event  time  (LIFT) 

(4)  Cargo  event  time  (CPSN) 

(5)  Cargo  event  time  (LAND) 


Integer 

. 

Input 

(6)  Cargo  event  time  (LDUN) 
Number  of  delays. 

Integer 

20 

Input 

Delay  event  time. 

Integer 

20 

Input 

Delay  event  type. 

Integer 

- 

Input 

Elapsed  time  from  the  beginning 

of  the  test. 

Common  Blocks 


Block  Name 


Input 


Output 


TBLUNIT 


NUNIT1 »  NUNIT2, 
NUNIT3,  NUNIT4 


Subroutines  Called 


FIGURE  4. 


.  MAIN  PROGRAM  (STEP  13)  FLOW  DIAGRAM 
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MAIN  PROGRAM  STEP! 3 


To  write  previous  LDUN  on  present  record  and  to  compute  the  parts  of  the  crane 
cycle. 


TAPE1 


TAPE2 


Facility  ID 
Julian  date 
Shift 

Operator  ID 
Lighter  type 
Lighter  ID 
Cargo  ID 
Cargo  cycle 
LDOC 
LDLK 
LIFT 
CPSN 
LAND 
LDUN 

Delay  start 
Delay  type 
Sequence  number 

Minutes  elapsed  from  the  beginning 
of  the  test. 

Binary  Output  A  TAPE2  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 
(71  Cargo  ID 
(8)  Cargo  cycle 
(9  LDOC 

(10)  LDOC  -  previous  LDUN 
11  LDLK 
(12)  LDLK  -  LDOC 
(13  LIFT 

(14)  LIFT  -  LDLK 

(15)  CPSN 

(16)  CPSN  -  LIFT 
17  LAND 
18)  LAND  -  CPSN 
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MAIN  PROGRAM  STEP! 3  (CONTINUED) 


(19)  LDUN 

(20)  LDUN  -  LAND 

(21)  Delay  start 

(22)  Delay  type 

(23)  Sequence  number 

An  OUTPUT  record  contains  the  same 
parameters  as  a  TAPE2  record. 
Contains  system  messages,  if  any. 


MAIN  STEP13 

SUBROUTINE  COMPUTE  (1) 


Purpose 

To  compute  the  component  parts  of  a  crane  cycle. 
Calling  Sequence 

CALL  COMPUTE  (NDATA,  NPREV,  NTIME) 


VARIABLE  TYPE 


DIMENSION  USE  DESCRIPTION 


NDATA  Integer  17 


NPREV  Integer  3 


NTIME  Integer  6 


Input  A  NDATA  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 
(3  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  LDOC 

(10)  LDLK 

(11)  LIFT 

(12)  CPSN 
13)  LAND 

(14)  LDUN 

(15)  Delay  start 

(16)  Delay  type 

(17)  Sequence  number 
Input  A  NPREV  record  contains: 

(1)  previous  Julian  date 

(2)  previous  shift 

(3)  previous  time 
Output  A  NTIME  record  contains: 

(1)  LDOC  -  previous  LDUN 

(2)  LDLK  -  LDOC 

(3)  LIFT  -  LDLK 

4)  CPSN  -  LIFT 

5)  LAND  -  CPSN 
(6)  LDUN  -  LAND 


M  mm  a 


[I] 


MAIN  STEP! 3 
SUBROUTINE  SAVE 
Purpose 


i 


To  return  previous  LDUN. 
Calling  Sequence 


CALL  SAVE  (NFACID,  NDATE,  NSHIFT,  NLDUN,  NPREV) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

NFACID 

Integer 

_ 

Input 

Facility  ID 

NDATE 

Integer 

- 

Input 

Julian  date 

NSHIFT 

Integer 

- 

Input 

Shift 

NLDUN 

Integer 

- 

Input 

Present  LDUN 

NPREV 

Integer 

Input 

(1)  previous  Julian  date 

(2)  previous  shift 

(3)  previous  LDUN 

a 
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FIGURE  4.14.  MAIN  PROGRAM  (STEP  15)  FLOW  DIAGRAM 
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MAIN  PROGRAM  STEP! 5 


Purpose 

To  combine  a  lighter  record  and  a  cargo  record  into  one  record. 
Program  Statement 


PROGRAM  STEP! 5  (UNIT8A,  UNIT14,  0UTI1 5 ,  0UTC16,  UNIT! 5 ,  OUTPUT) 

FILE  NAME  TYPE  USE  DESCRIPTION 

UNIT8A  Binary  Input  A  UNIT8A  record  contains: 

(1 )  Facility  ID 

(2)  Julian  date 
(3  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction  (F/R) 

(9)  LRDY 

(10)  LRDP 

(11)  Lighter  at  ship  time  (LRDY-LRDP) 

(12)  Lighter  succession  time  (LRDY-previous 
LRDPP) 

(13)  Lighter  at  ship  cycle  time  (LRDP- 
previous  LRDP) 

(14)  Cargo  type 

(15)  Cargo  ID 

UNIT14  Binary  Input  A  UNIT14  record  contains: 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  LDOC 

(10)  LDOC  -  previous  LDUN 

(11)  LDLK 

(12)  LDLK  -  LDOC 

(13)  LIFT 

(14)  LIFT  -  LDLK 

(15)  CPSN 

(16)  CPSN  -  LIFT 

(17)  LAND 

(18)  LAND  -  CPSN 

(19)  LDUN 

(20)  LDUN  -  LAND 

(21)  Delay  start 

(22)  Delay  type 

(23)  Delay  sequence  number 


MAIN  PROGRAM  STEP! 5  (CONTINUED) 


FILE  NAME 

TYPE 

USE 

0UTI15 

BCD 

Output 

0UTC15 

BCD 

Output 

UNIT15  Binary  Output 

OUTPUT  BCD  Output 


DESCRIPTION 

Contains  a  non-matching  UNIT8A  or 
UN  ITT  4  record. 

An  0UTC15  record  contains: 

(1 )  Facility  ID 

2)  Julian  date 

3)  shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction  (F/R) 

(9)  LRDY 

(10)  LRDP 

(11)  LRDP  -  LRDY 

12)  LRDY  -  previous  LRDP 

13)  LRDP  -  previous  LRDP 

(14)  Cargo  type 

(15)  Cargo  ID 

(16)  Operator  ID 

(17)  LDOC 

(18)  LDOC  -  previous  LDUN 

(19)  LDLK 

(20)  LDLK  -  LDOC 
21)  LIFT 

(22)  LIFT  -  LDLK 

(23)  CPSN 

(24)  CPSN  -  LIFT 

(25)  LAND 

(26)  LAND  -  CPSN 

(27)  LDUN 

28)  LDUN  -  LAND 

29)  Delay  start 

(30)  Delay  type 

(31)  Delay  sequence  number 

(32)  Minutes  elapsed  from  the  beginning 

of  the  test. 

An  UNIT15  record  contains  the  same 
parameters  as  an  0UTC15  record. 
Contains  systems  messages,  if  any. 
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MAIN  STEP! 5 


SUBROUTINE  READ  (1) 

Purpose 

To  read  a  record  from  the  lighter  times  file  and/or  the  cargo  times  file. 
Calling  Sequence 

CALL  READ  (KODE,  LIGHTER,  NCARGO ,  NEND) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

KODE 

Integer 

2 

Input 

(1)  Flag  to  read 

(2)  Flag  to  read 

a  file  1  record, 
a  file  2  record. 

LIGHTER 

Integer 

15 

Output 

(l)  Facility  ID 

(2)  Julian  date 

(3)  Shift 


NCARGO  Integer  23 


Output 


(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction 

(9)  Lighter  event  time  (LRDY) 

(10)  Lighter  event  time  (LRDP) 

(11)  LRDP  -  LRDY 

(12)  LRDY  -  previous  LRDP 

(13)  LRDP  -  previous  LRDP 

(14)  Cargo  type 

(15)  Cargo  ID 

(1 )  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  Cargo  event  time  (LDOC) 

(10)  LDOC  -  previous  LDUN 

(11)  Cargo  event  time  (LDLK) 

(12)  LDLK  -  LDOC 

(13)  Cargo  event  time  (LIFT) 

14  LIFT  -  LDLK 

(15)  Cargo  event  time  (CPSN) 

(16)  CPSN  -  LIFT 

(17)  Cargo  event  time  (LAND) 

(18)  LAND  -  CPSN 

(19)  Cargo  event  time  (LDUN) 

(20)  LDUN  -  LAND 

(21 )  Delay  start  time 

(22)  Delay  type 

(23)  Delay  sequence  number 
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MAIN  STEP 1 5  (CONTINUED) 
SUBROUTINE  READ  (1) 


VARIABLE  TYPE 

NEND  Integer 

Common  Blocks 
Block  Name 


DIMENSION 

USE 

DESCRIPTION 

2 

Output 

Equals  EOF  when  end  of  file 

is  reached. 

Input 

Output 

TBLUNIT  NUNIT1 ,  NUNIT2,  NONE 

NUNIT3,  NUNIT4, 

NUNIT5,  NUNIT6 


Subroutines  Called 


MAIN  STEP15 


SUBROUTINE  COMPARE  (2) 

Purpose 

To  determine  if  two  records  match  on  four  match  keys  (i.e.,  facility  ID, 
Lighter  type,  lighter  ID  and  cargo  ID).  If  there  is  no  match,  it  returns  to  the 
main  program  the  first  key  where  the  match  failed. 

Calling  Sequence 

CALL  COMPARE  (NTEST1 ,  NTEST2,  MATCH,  NFAIL1 ,  NFAIL2) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

NTEST1 

Integer 

4 

Input 

NTEST1  is  constructed  from  the 
LIGHTER  record 

(1) 

1  Facility  ID 

2 

1  Lighter  type 

3 

l  Lighter  ID 

(4) 

l  Cargo  ID 

NTEST2 

Integer 

4 

Input 

NTEST2  is  constructed  from  the 
NCARGO  record 

81 

1  Facility  ID 
l  Lighter  type 

1  Lighter  ID 

1  Cargo  ID 

MATCH 

Logical 

Output 

MATCH  equals  true  if  a  match 
was  found.  MATCH  equals  false 
if  the  match  failed. 

NFAIL1 

Integer 

Output 

Contains  the  first  LIGHTER 
match  key  where  the  match 
failed. 

NFAIL2 

Integer 

Output 

Contains  the  first  NCARGO 
match  key  where  the  match 
failed. 

Common  Blocks 

Block  Name 

Input 

Output 

NONE 

NONE 

NONE 

Subroutines  Called 

MAIN  STEP  1 5 
SUBROUTINE  SETUP  (3) 
Purpose 


To  construct  two  arrays  with  facility  ID,  lighter  type,  lighter  ID,  and  cargo  ID. 
Calling  Sequence 


CALL  SETUP  (LIGHTER,  NCARGO ,  NTEST1 ,  NTEST2) 


VARIABLE 


DIMENSION 


DESCRIPTION 


LIGHTER 

Integer 

15 

Input 

i 

Facility  ID 

Julian  date 

(3 

Shift 

(4 

Lighter  type 

5 

Lighter  ID 

6< 

Lighter  cycle 

7 

Lighter  position 

(s! 

Direction 

o: 

no; 

in; 

Lighter  event  time  (LRDY) 
Lighter  event  time  (LRDP) 

LRDP  -  LRDY 

p2; 

LRDY  -  previous  LRDP 

13 

LRDP  -  previous  LRDP 

(14) 

15) 

Cargo  type 

Cargo  ID 

NCARGO 

Integer 

23 

Input 

n: 

Facility  ID 

2; 

Julian  date 

3 

Shift 

4) 

Operator  ID 

(5; 

Lighter  type 

e) 

Lighter  ID 

7) 

Cargo  ID 

(8 

Cargo  cycle 

(9 

Cargo  event  time  (LDOC) 

(10) 

LDOC  -  previous  LDUN 

h: 

Cargo  event  time  (LDLK) 

(12) 

LDLK  -  LDOC 

(13) 

Cargo  event  time  (LIFT) 

(14! 

LIFT  -  LDLK 

(15) 

Cargo  event  time  (CPSN) 

(16) 

CPSN  -  LIFT 

(17) 

Cargo  event  time  (LAND) 

(18) 

LAND  -  CPSN 

(19) 

Cargo  event  time  (LDUN) 

(20) 

LDUN  -  LAND 

(21) 

Delay  start  time 

(22) 

Delay  type 

(23) 

Delay  sequence  number 

MAIN  STEP15 

SUBROUTINE  SETUP  (3)  (CONTINUED) 

DESCRIPTION 

NTEST1  is  constructed  from  the 
LIGHTER  record. 

(1)  Facility  ID 

(2)  Lighter  type 

(3)  Lighter  ID 

(4)  Cargo  ID 

NTEST2  is  constructed  from  the 
NCARGO  record. 

(1)  Facility  ID 

(2)  Lighter  type 
3  Lighter  ID 

(4)  Cargo  ID 

Common  Blocks 

Block  Name  Input  Output 

NONE  NONE  NONE 

Subroutines  Called 
NONE 


VARIABLE 

TYPE 

DIMENSION 

USE 

NTEST1 

Integer 

4 

Output 

NTEST2 

Integer 

4 

Output 
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MAIN  STEP15 
SUBROUTINE  SELECT  (4) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

NFAIL1 

Integer 

- 

Output 

Contains  the  first  LIGHTER 
match  key  where  the  match 
failed. 

NFAIL2 

Integer 

Output 

Contains  the  first  NCARGO 
match  key  where  the  match 
failed. 

KODE 

Integer 

2 

Input 

(1)  Flag  to  read  a  file  1  record. 

(2)  Flag  to  read  a  file  2  record. 

Common  Blocks 


Block  Name 
NONE 


Subroutines  Called 


Input 

NONE 


Output 

NONE 


MAIN  STEP! 5 
SUBROUTINE  CONVERT  (5) 
Purpose 


To  convert  days,  shifts,  hours,  and  minutes  to  minutes  from  beginning  of  test. 
Calling  Sequence 


CALL  CONVERT  (NDAY ,  NSHIFT,  NHM,  MINS) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

NDAY 

Integer 

Input 

Julian  date. 

NSHIFT 

Integer 

- 

Input 

First  or  second  shift. 

NHM 

Integer 

• 

Input 

Time  of  day  in  hours  and 
minutes  (military  time). 

MINS 

Integer 

• 

Output 

Minutes  elapsed  from  the 
beginning  of  the  test. 

Common  Blocks 
Block  Name 
NONE 


Subroutines  Called 


Input 

NONE 


NONE 


MAIN  STEP 1 5 
SUBROUTINE  RPTINC  (6) 

Purpose 

To  write  an  incomplete  lighter  or  cargo  record. 
Calling  Sequence 

CALL  RPTINC  (KODE,  LIGHTER,  NCARGO ,  NPRINT) 


VARIABLE 


LIGHTER 


DIMENSION 


Integer 

Integer 


Input 

Input 


NCARGO 


Integer 


Input 


DESCRIPTION 


(1)  Flag  to  read  a  file  1  record. 

(2)  Flag  to  read  a  file  2  record. 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction 

(9)  Lighter  event  time  (LRDY) 

(10)  Lighter  event  time  (LRDP) 

(11)  LRDP  -  LRDY 

(12)  LRDY  -  previous  LRDP 

(13)  LRDP  -  previous  LRDP 

(14)  Cargo  type 

(15)  Cargo  ID 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  Cargo  event  time  (LDOC) 

(10)  LDOC  -  previous  LDUN 

(11)  Cargo  event  time  (LDLK) 

(12)  LDLK  -  LDOC 

(13)  Cargo  event  time  (LIFT) 

(14)  LIFT  -  LDLK 

(15)  Cargo  event  time  (CPSN) 

(16)  CPSN  -  LIFT 

(17)  Cargo  event  time  (LAND) 

(18)  LAND  -  CPSN 

(19)  Cargo  event  time  (LDUN) 

(20)  LDUN  -  LAND 

(21)  Delay  start  time 

(22)  Delay  type 

(23)  Delay  sequence  number 


MAIN  STEP! 5 

SUBROUTINE  RPTINC  (6)  (CONTINUED) 

VARIABLE  TYPE  DIMENSION  USE  DESCRIPTION 

NPRINT  Logical  -  Input  NPRINT  equals  true  when  a 

match  was  found  for  a  lighter 
record.  NPRINT  equals  false  when 
a  match  was  not  found  for  a 
lighter  record. 

Common  Blocks 


Block  Name 

Input 

Output 

TBLUNIT 

NUNIT1 ,  NUNIT2, 

NONE 

NUNIT3,  NUNIT4, 

NUNIT5,  NUNIT6 

Subroutines  Called 


None 
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MAIN  STEP15 


SUBROUTINE  RPTCOM  (7) 
Purpose 


To  write  a  complete  lighter  or  cargo  record. 
Calling  Sequence 

CALL  RPTCOM  (LIGHTER,  NCARGO ,  NTIME,  NPRINT) 


VARIABLE  TYPE 


DIMENSION  USE  DESCRIPTION 


LIGHTER  Integer  15 


NCARGO  Integer  23 


Input 


Input 


(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction 

(9)  Lighter  event  time  (LRDY) 

(10)  Lighter  event  time  (LRDP) 

(11)  LRDP  -  LRDY 

(12)  LRDY  -  previous  LRDP 

(13)  LRDP  -  previous  LRDP 

(14)  Cargo  type 

(15)  Cargo  ID 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Operator  ID 

(5)  Lighter  type 

(6)  Lighter  ID 

(7)  Cargo  ID 

(8)  Cargo  cycle 

(9)  Cargo  event  time  (LDOC) 

(10)  LDOC  -  previous  LDUN 

(11)  Cargo  event  time  (LDLK) 

(12)  LDLK  -  LDOC 

(13)  Cargo  event  time  (LIFT) 

(14)  LIFT  -  LDLK 

(15)  Cargo  event  time  (CPSN) 

16  CPSN  -  LIFT 

(17)  Cargo  event  time  (LAND) 

(18)  LAND  -  CPSN 

(19)  Cargo  event  time  (LDUN) 

(20)  LDUN  -  LAND 

(21)  Delay  start  time 

(22)  Delay  type 

(23)  Delay  sequence  number 


MAIN  STEP! 5 


SUBROUTINE  RPTCOM  (7)  (CONTINUED) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

NTIME 

NPRINT 

Integer 

Logical 

- 

Input 

Input 

Elapsed  time  ' 
of  the  test. 
NPRINT  equals 
was  found  for 
NPRINT  equals 
was  not  found 

from  the  beginning 

true  when  a  match 
a  lighter  record, 
false  when  a  match 
for  a  lighter  record 

Common  Blocks 

Block  Name 

Input 

Output 

TBLUNIT 

NUNIT1 , 
NUNIT3, 
NUNIT5, 

NUNIT2 

NUNIT4, 

NUNIT6 

NONE 

Subroutines  Called 


MAIM  STEP! 5 
SUBROUTINE  STOP  (8) 

Purpose 

To  determine  if  EOF  in  any  file  or  in  all  files.  Sets  KODE  to  indicate  record. 
Calling  Sequence 

CALL  STOP  (NEND,  NSTOP,  NST0P1 ,  KODE) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

NEND 

Integer 

2 

Input 

Equals  EOF  when  end  of  file 
is  reached. 

NSTOP 

Logical 

Input 

When  NSTOP  is  false,  all  files 
contain  data.  When  NSTOP  is 
true,  at  least  one  stop  is 
out  of  data. 

NSTOP1 

Logical 

- 

Input 

When  NST0P1  is  true,  all  files 
are  out  of  data. 

KODE 

Common  Blocks 

Integer 

2 

Output 

(1)  Flag  to  read  a  file  1  record. 

(2)  Flag  to  read  a  file  2  record. 

Block  Name  Input  Output 


NONE  NONE  NONE 

Subroutines  Called 


NONE 


ACCTY  INTY  PGBRK  FrtNIND  PRNTST  CHECK 


READ 


CALL 

CHECK 


PAGE 
BREAK 
<  ?  > 


LIGHTER 
BREAK 
\  / 


CALL 

PRNTST 

INTY 

ACCTY 

PRNINO 


F/R 

BREAK 
.  ?  > 


CALL 

IS 

CALL 

CHECK 

PRNTST 

call 

PGBRK 


CALL 

PRNINO 

ACCTY 


FIGURE  4.16.  MAIN  PROGRAM  (WRTRPT)  FLOW  DIAGRAM 
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MAIN  PROGRAM  WRTRPT 


Purpose 


To  read  the  sorted  lighter  and  cargo  times  file,  compute  statistics  and  write 
a  report.  For  each  facility,  date  and  shift,  statistics  are  accumulated  on 
lighter  types. 

Program  Statement 

PROGRAM  WRTRPT  (TAPE!,  OUTPUT) 


FILE  NAME  TYPE  USE 


DESCRIPTION 


TAPE! 


Binary  Input 


(D 

(2) 

(3) 

(4) 

(5) 

(6) 

(7) 

(8) 
(9) 

00) 

ia 

03) 

04) 

05 

06) 

07) 

IS! 

(20) 

(21) 

(22) 

(23) 

(24 

(25) 

(26) 
(27) 


(29) 

(30) 

(31) 

(32) 


Facility  ID 
Julian  date 
Shift 

Lighter  type 
Lighter  ID 
Lighter  cycle 
Lighter  Position 
Direction  (F/R) 

LRDY 

LRDP 

LRDP  -  LRDY 

LRDY  -  previous  LRDP 

LRDP  -  previous  LRDP 

Cargo  type 

Cargo  ID 

Operator  ID 

LDOC 

LDOC  -  previous  LDUN 
LDLK 

LDLK  -  LDOC 
LIFT 

LIFT  -  LDLK 
CPSN 

CPSN  -  LIFT 
LAND 

LAND  -  CPSN 
LDUN 

LDUN  -  LAND 
Delay  start 
Delay  type 

Delay  sequence  number 

Minutes  elapsed  from  the  beginning 

of  the  test. 


MAIN  PROGRAM  WRTRPT  (CONTINUED) 
FILE  NAME  TYPE  USE 

OUTPUT  BCD  Output 


DESCRIPTION 

The  first  30  input  numbers  plus  the 
mean  and  standard  deviation  of  the 
following: 

(1)  LRDP  -  LRDY 

(2)  LRDY  -  previous  LRDP 

(3)  LRDP  -  previous  LRDP 

(4)  LDOC  -  previous  LDUN 

(5)  LDLK  -  LDOC 

(6)  LIFT  -  LDLK 

(7)  CPSN  -  LIFT 

8  LAND  -  CPSN 

(9)  LUND  -  LAND 


MAIN  WRTPRT 


SUBROUTINE  ACCTY  (1) 

Purpose 

To  accumulate  lighter  type  statistics 
Calling  Sequence 

CALL  ACCTY (SUMTY,  SUMSQTY,  NOTYF,  NOTYR,  N.SAME) 


VARIABLE  TYPE 


DIMENSION  USE  DESCRIPTION 


SUMTY  Real 


9,2  Input  &  (1,1) 

Output  (2,1) 
vious 

(3.1) 
vious 

(4.1) 
vious 


(5.1) 

(6.1) 


(8,1) 

(9,1) 


Sum  of  forward  LRDP-LRDY 
Sum  of  forward  LRDY-Pre- 
LRDP 

Sum  of  forward  LRDP-pre- 
LRDP 

Sum  of  forward  LDOC-pre- 
LDUN 

Sum  of  forward  LDLK-LDOC 
Sum  of  forward  LIFT-LDLK 
Sum  of  forward  CPSN-LIFT 
Sum  of  forward  LAND-CPSN 
Sum  of  forward  LUND- LAND 


(1,2)  -  (9,2)  Sums  of  the  same 
9  times  as  above  except  retro¬ 
grade  instead  forward. 


SUMSQTY 

Real 

6,2 

Input  & 

Corresponding  sums  of  squares 

Output 

of 

times  above. 

NOTYF 

Integer 

9 

Inputs 

Number  of  each  of  the  above 

Output 

forward  times. 

NOTYR 

Integer 

9 

Input  S 

Number  of  each  of  the  above 

Output 

retrograde  times. 

N 

Integer 

32 

Input 

8 

Facility  ID 

Julian  date 

o: 

Shift 

(4; 

Lighter  type 

(5; 

Lighter  ID 

(e; 

lej 

Lighter  cycle 

Lighter  position 

Direction  (F/R) 

(ioi 

LRDY 

LRDP 

pi: 

LRDP  -  LRDY 

;i2; 

LRDY  -  previous  LRDP 

!13l 

LRDP  -  previous  LRDP 

14 

Cargo  type 

(15) 

Cargo  ID 

:ie; 

Operator  ID 

4-72 


MAIN  WRTPRT 

SUBROUTINE  ACCTY  (1)  (CONTINUED) 

VARIABLE  TYPE  DIMENSION  USE  DESCRIPTION 

(17)  LDOC 

(18)  LDOC  -  previous  LDUN 

(19)  LDLK 

(20)  LDLK  -  LDOC 

(21)  LIFT 

(22)  LIFT  -  LDLK 

(23)  CPSN 

(24)  CPSN  -  LIFT 

(25)  LAND 

(26)  LAND  -  CPSN 

(27)  LDUN 

(28)  LDUN  -  LAND 

(29)  Delay  start 

(30)  Delay  type 

(31)  Delay  sequence  number 

(32)  Minutes  elapsed  from  the 

beginning  of  the  test. 

SAME  Logical  -  Input  Equals  false  when  lighter  part 

of  record  is  different  from 
previous  record  and  equals  true 
when  lighter  part  of  record  is 
the  same  as  previous  record. 

Common  Blocks 
NONE 

Subroutines  Called 
NONE 
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MAIM  WRTRPT 


SUBROUTINE  INTY  (2) 

Purpose 

Initialize  statistics  parameters. 
Calling  Sequence 

CALL  INTY{SUMTY,  SUMSQTY ,  NOTYF,  NOTYR) 


VARIABLE  TYPE 


DIMENSION  USE  DESCRIPTION 


SUMTY  Real  9,2 


Output 


(1.1)  Sum  of 

(2.1 )  Sum  of 
vious  LRDP 

(3.1 )  Sum  of 
vious  LRDP 

(4.1 )  Sum  of 
vious  LDUN 

(5.1 )  Sum  of 

(6.1 )  Sum  of 

(7.1 )  Sum  of 

(8.1 )  Sum  of 

(9.1 )  Sum  of 


forward  LRDP-LRDY 
forward  LRDY-pre- 

forward  LRDP-pre- 

forward  LDOC-pre- 

forward  LDLK-LDOC 
forward  LIFT-LDLK 
forward  CPSN-LIFT 
forward  LAND-CPSN 
forward  LUND-LAND 


SUMSQTY 

Real 

9,2 

Output 

NOTYF 

Integer 

9 

Output 

NOTYR 

Integer 

9 

Output 

Common  Blocks 

n - 

Subroutines  Called 


(1,2)  -  (9,2)  Sums  of  the  same 
9  times  as  above  except  retro¬ 
grade  instead  forward. 
Corresponding  sums  of  squares 
of  times  above. 

Number  of  each  of  the  above 
forward  times. 

Number  of  each  of  the  above 
retrograde  times. 


NONE 
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MAIN  WRTRPT 
SUBROUTINE  PGBRK  (3) 
Purpose 


To  write  page  headings  and  to  print  lighter/  argo  records  and  statistics. 
Calling  Sequence 

CALL  PGBRK(FIRST,  OFAL,  ODATE,  OSHIFT,  N,  KPGBR,  OLTRTY,  OFR,  SUMTY,  SUMSQTY , 
NOTYF,  NOTYR,  SAME) 


VARIABLE 


DIMENSION 


DESCRIPTION 


Input  First  call  indicator 

Output  Current  Facility  ID 

Output  Current  date 

Input  (1) 

1  Facility  ID 

(2] 

)  Julian  date 

O; 

Shift 

(4; 

Lighter  type 

(5] 

Lighter  ID 

(e; 

Lighter  cycle 

(7; 

Lighter  position 

(s; 

Direction  (F/R) 

(9] 

LRDY 

(10) 

LRDP 

(ID 

LRDP-LRDY 

(12) 

LRDY-previous  LRDP 

(13) 

LRDP-previous  LRDP 

14 

Cargo  type 

(15) 

Cargo  ID 

P6 

Operator  ID 

07) 

LDOC 

(18) 

LDOC-previous  LDUN 

(19) 

LDLK 

(20) 

LDLK-LDOC 

(21) 

LIFT 

(22) 

LIFT-LDLK 

23 

CPSN 

(24 

CPSN-LIFT 

(25) 

LAND 

(26) 

LAND-CPSN 

27) 

LDUN 

(28) 

LDUN-LAND 

(29) 

Delay  start 

30 

Delay  type 

(31) 

Delay  sequence  number 

(32) 

Minutes  elapsed  from  the 

beginning  of  the  test. 

MAIN  WRTRPT 


SUBROUTINE  PGBRK  (3)  (CONTINUED) 


VARIABLE 


KPGBR 

OLTRTY 

OFR 

SUMTY 


DIMENSION 


Logical 

Real 

Real 


Output 

Output 

Output 

Input 


SUMSQTY 

NOTYR 


NOTYF 


Common  Blocks 


Integer 

Integer 

Logical 


Input 

Input 

Input 

Input 


DESCRIPTION 


Page  break  indicator 
Current  lighter  type 
Current  forward/retrograde 
indicator. 

(1.1)  Sum  of  forward  LRDP-LRDY 

(2.1)  Sum  of  forward  LRDY-pre- 

vious  LRDP 

(3.1)  Sum  of  forward  LRDP-pre- 
vious  LRDP 

(4.1)  Sum  of  forward  LDOC-pre- 
vious  LDUN 

(5.1)  Sum  of  forward  LDLK-LDOC 

(6.1)  Sum  of  forward  LIFT-LDLK 

(7.1)  Sum  of  forward  CPSN-LIFT 

(8.1)  Sum  of  forward  LAND-CPSN 

(9.1)  Sum  of  forward  LUND-LAND 

(1.2)  -  (9,2)  Sums  of  the  same 
9  times  as  above  except  retro¬ 
grade  instead  forward. 
Corresponding  sums  of  squares 
of  times  above. 

Number  of  each  of  the  above 
retrograde  times. 

Number  of  each  of  the  above 
forward  times. 

Same  lighter  part  of  record 
indicator. 


Subroutines  Called 

CCTY 
NTY 
RNIND 
RNTST 


MAIN  WRTRPT 
SUBROUTINE  PRNIND  (4) 

Purpose 

To  write  individual  lighter/cargo  records. 
Calling  Sequence 


CALL  PRNIND  (N,  SAME) 
VARIABLE  TYPE 


DIMENSION 


DESCRIPTION 


(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction  (F/R) 

(9)  LRDY 

(10)  LRDP 

(11)  LRDP-LRDY 

(12)  LRDY-previous  LRDP 

(13)  LRDP-previous  LRDP 

(14)  Cargo  type 

(15)  Cargo  ID 

(16)  Operator  ID 

(17)  LDOC 

(18)  LDOC-previous  LDUN 

(19)  LDLK 

(20)  LDLK-LDOC 

(21)  LIFT 

(22)  LIFT-LDLK 

(23)  CPSN 

(24)  CPSN-LIFT 

(25)  LAND 

(26)  LAND-CPSN 
27)  LDUN 

(28)  LDUN-LAND 

(29)  Delay  start 

(30)  Delay  type 

(31)  Delay  sequence  number 

(32)  Minutes  elapsed  from  the 
beginning  of  the  test. 

Same  lighter  part  of  record 
indicator. 


MAIN  WRTRPT 
SUBROUTINE  PRNTST  (5) 


Purpose 

To  compute  and  print  lighter  type  statistics. 

Calling  Sequence 

CALL  PRNTST  (SUMTY,  SUMSQTY,  NOTYF,  NOTYR) 

VARIABLE  TYPE  DIMENSION  USE  DESCRIPTION 


SUMTY  Real  9,2 


SUMSQTY  Real  9,2 

NOTYF  Integer  9 

NOTYR  Integer  9 


Input 


Input 

Input 

Input 


(1,1) 

(2,1) 

vious 

(3.1) 

vious 

(4.1) 
vious 

(5.1) 

(6.1) 

(7.1) 

(8.1) 

(9,1) 


Sum  of  forward  LRDP-LRDY 
Sum  of  forward  LRDY-pre- 
LRDP 

Sum  of  forward  LRDP-pre- 
LRDP 

Sum  of  forward  LDOC-pre- 
LDUN 

Sum  of  forward  LDLK-LDOC 
Sum  of  forward  LIFT-LDLK 
Sum  of  forward  CPSN-LIFT 
Sum  of  forward  LAND-CPSN 
Sum  of  forward  LUND-LAND 


(1,2)  -  (9,2)  Sums  of  the  same 
9  times  as  above  except  retro¬ 
grade  instead  forward. 
Corresponding  sums  of  squares 
of  times  above. 

Number  of  each  of  the  above 
forward  times. 

Number  of  each  of  the  above 
retrograde  times. 


Common  Blocks 
NONE 

Subroutines  Called 


NONE 


MAIN  WRTRPT 


SUBROUTINE  CHECK  (6) 

Purpose 

To  determine  if  the  present  lighter  record  is  the  same  as  the  previous  lighter 
record. 

Calling  Sequence 


CALL  CHECK(N,  SAME) 
VARIABLE  TYPE 


DIMENSION  USE  DESCRIPTION 


Input  (1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Lighter  type 

(5)  Lighter  ID 

(6)  Lighter  cycle 

(7)  Lighter  position 

(8)  Direction  (F/R) 

(9)  LRDY 

(10)  LRDP 

(11)  LRDP-LRDY 

(12)  LRDY-previous  LRDP 

(13)  LRDP-previous  LRDP 

(14)  Cargo  type 

(15)  Cargo  ID 

(16)  Operator  ID 

(17)  LDOC 

(18)  LDOC-previous  LDUN 

(19)  LDLK 

(20)  LDLK-LDOC 

(21)  LIFT 

(22)  LIFT-LDLK 

(23)  CPSN 

(24)  CPSN-LIFT 

(25)  LAND 

(26)  LAND-CPSN 

(27)  LDUN 

28)  LDUN-LAND 

(29)  Delay  start 

(30)  Delay  type 

(31)  Delay  sequence  number 

(32)  Minutes  elapsed  from  the 
beginning  of  the  test. 

Output  Equals  false  when  lighter  part 
of  record  is  different  from 
previous  record  and  equals  true 
when  lighter  part  of  record  is 
the  same  as  previous  record. 


Mail 


MAIN  WRTRPT 


SUBROUTINE  CHECK  (6 
Common  Blocks 
NONE 

Subroutines  Called 
NONE 


)  (CONTINUED) 
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JOINT  LOGISTICS-OVER-THE-SHGRE  (LOTS;  MAIN  TEST  3A 
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V.  CRANE  CYCLE  TIMES  PROGRAM 


INTRODUCTION 

The  purpose  of  the  Crane  Cycle  Times  Program  Is  to  select  crane  cycles 
that  have  certain  attributes  that  are  Input  to  the  program.  The  mean, 
standard  deviation,  median  and  as  an  option  a  histogram  are  computed  for  the 
selected  cycles.  The  statistics  are  accumulated  by  shift  and  phase. 

A  sample  output  is  given  In  Figure  5.1. 

PROGRAM  DESCRIPTION 

The  Crane  Cycle  Times  Program  is  composed  of  a  System  2000  retrieval 
program,  two  main  programs  and  24  routines. 

A  description  of  each  program  Is  given  starting  with  the  System  2000 
retrieval  program  followed  by  the  two  main  programs.  The  description  of  each 
main  program  contains  a  structure  diagram,  a  flow  chart  of  the  main  program 
followed  by  a  write-up  of  each  main  program  and  routine. 
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FIGURE  5.1.  CRANE  CYCLE  TIMES  PROGRAM  SAMPLE 


SYSTEM  2000  RETRIEVALS  FOR  PROGRAM  MAGIC 


Purpose 


To  retrieve  crane  cycle  data  from  the  LOTS  System  2000  Data  Base 
and  to  write  the  data  on  a  file. 


FILE  NAME 

TYPE 

USE 

DESCRIPTION 

RETRS2K 

BCD 

OUTPUT 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Cargo  ID 

(5)  Cargo  cycle 

(6)  Discharging  carrier 
type 

(7)  Discharging  carrier  ID 

(8)  Receiving  carrier  type 

(9)  Receiving  carrier  ID 

(10)  Sllng/lifting  device 

(11)  Crane  operator 

12)  Cargo  event  name 

13)  Cargo  event  time  (LDOC 


CONVERT 

(1) 


FIGURE  5.2.  MAGIC  STRUCTURE 


MAIN  PROGRAM  MAGIC 


Purpose 


To  convert  Julian  data,  shift,  and  hours  and  minutes  to  minutes 
elapsed  from  the  beginning  of  the  test. 


Program  Statement 

PROGRAM  MAGIC  (TAPE1 ,  TAPE2,  OUTPUT) 


FILE  NAME  TYPE 


USE  DESCRIPTION 


TAPE1 


TAPE2 


BCD 


BCD 


Input 


Output 


Output 


(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Cargo  ID 

(5)  Cargo  cycle 

(6)  Discharging  carrier  type 
(71  Discharging  carrier  ID 

(8)  Receiving  carrier  type 

(9)  Receiving  carrier  ID 

(10)  Sling/lifting  device 

(11)  Crane  operator 

(12)  Cargo  event  name 

(13)  Cargo  event  time  (LDOC  or  DELY) 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Cargo  ID 

(5)  Cargo  cycle 

(6)  Discharging  carrier  type 

(7)  Discharging  carrier  ID 

(8)  Receiving  carrier  type 

(9)  Receiving  carrier  ID 
(10)  Sling/liftlng  device 

!11)  Crane  operator 
12)  Cargo  event  name 
13)  Cargo  event  time  (LDOC  or  DELY) 
14)  Elapsed  time  in  minutes  from  the 
beginning  of  the  test. 

Contains  system  messages,  if  any 


OUTPUT 


BCD 


MAIN  MAGIC 

SUBROUTINE  CONVERT  1 
Purpose 

Converts  day,  shift,  hours,  and  minutes  to  minutes  from  the  beginning 
of  the  test. 

Calling  Sequence 

CALL  CONVERT  (NDAY,  NSHIFT,  NHM,  MINS,  MTIME) 


Variable 

Type 

Dimension  Use 

NDAY 

Integer 

Input 

NSHIFT 

Integer 

Input 

NHM 

Integer 

Input 

MINS 

Integer 

Output 

NTIME 

Integer 

Output 

Common  Blocks 

Block  Name  Input  Output 

None  None  None 

Subroutines  Called 


Description 

Julian  date. 

Shift  1  or  shift  2. 

Time  of  day  in  hours  and  minutes 
(military  time). 

Minutes  elapsed  from  the  beginning 
of  the  test. 

Time  of  day  In  hours  and  minutes. 
Times  after  midnight  on  shift  2  have 
2400  added  to  them 


None 


CRDB1NT 


FIGURE  5.4.  CYCLOPS  STRUCTURE 


MAIN  PROGRAM  CYCLOPS 


Purpose 


To  calculate  crane  cycles  and  to  produce  a  statistical  report  on 
selected  cycles. 

Program  Statement 

PROGRAM  CYCLOPS  (CARDF,  SCFILE,  DBINTR,  SCINTR,  REPORT,  OUTPUT, 


CGIDTS) 

FILE  NAME 

TYPE 

USE 

DESCRIPTION 

CARDF 

BCD 

Input 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

(4)  Cargo  ID 

(5)  Cargo  cycle 

(6)  Discharging  carrier  type 

(7)  Discharging  carrier  ID 

(8)  Receiving  carrier  type 

(9)  Receiving  carrier  ID 
(10;  Sling/lifting  device 

(11)  Crane  operator 

(12)  Cargo  event  name 

(13)  Cargo  event  time 

(14)  Elapsed  time  in  minutes  from  the 
beginning  of  the  test. 

SCFILE  BCD  Input  Selection  Criteria  Input  File 

(1)  Di recti on-of-movement 

(2)  Cycle  Interruption  code 

(3)  Sling/lifting  device 

(4)  Operator  ID 

(5)  Cycle  type 

(6)  Weight  category 

(7)  Lighter  sequence 

(8)  Special  transporter 

(9)  Cycle  start  lower  limit 

(10)  Cycle  start  upper  limit 

(11)  Cycle  duration  lower  limit 

(12)  Cycle  duration  upper  limit 

(13)  Number  of  histogram  bins 

(14)  Bln  size 

(15)  Print  histogram 

(16)  Title 

(17)  Sequence  number 


FILE  NAME 

TYPE 

USE 

DESCRIPTION 

DBINTR 

BINARY 

Input/ 

Output 

(1)  Direction  of  movement 

(2)  Cycle  type 

(3)  Operator  ID 

(4)  Sling/lifting  device 

(5)  Weight  category 

(6)  Cycle  start 

(7)  Cycle  duration 

(8)  Special  transporter 

(9)  Lighter  sequence 
(10)  Cycle  interruption  c 

SCJNTR 

BINARY 

Output 

This  file  contains  the  s  .  Parameters 
as  the  SCFILE  file  descr  above. 

SCINTR  is  an  expanded  vei-.on  of 
SCFILE. 

REPORT 

BCD 

Output 

This  file  contains  the  data  of  each 
SCINTR  record  followed  by  the  selected 
cycles  as  given  In  the  DBINTR  file. 

Output 

BCD 

Output 

This  file  contains  the  SCINTR  data  and 

the  statistical  report. 
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PROGRAM  CRDBINT  (1) 

Purpose 

To  create  the  data  base  intermediate  file 
OVERLAY  (1,0) 

Routines  Called 


RDCARDF 

GETIDWC 


PROGRAM  CRDBINT 
FUNCTION  RDCARDF  (1.1) 
Purpose 


To  read  the  "Cargo  Activities  Raw  Data  File" 
Calling  Sequence 

RDCARDF  (FP1 ,  FP2,  FP3,  FP4,  FP5,  FP6 ,  FP7,  FP8 

FP13) 


VARIABLE 

TYPE 

DIMENSION  USE 

FP1 

Integer 

Output 

FP2 

Integer 

Output 

FP3 

Integer 

Output 

FP4 

Integer 

Output 

FP5 

Integer 

Output 

FP6 

Integer 

Output 

FP7 

Integer 

Output 

FP8 

Integer 

Output 

FP9 

Integer 

Output 

FP10 

Integer 

Output 

FP1 1 

Integer 

-  Output 

FP12 

Integer 

Output 

FP13 

Integer 

-  Output 

Common  Blocks 


Block  Name  Input 

DBINFO 
NCDREC 

Routines  Called 

WGHTCAT 

CVOPRID 

CLASIFY 

MINUTES 


FP9 ,  FP10,  FP1 1 ,  FP12, 


DESCRIPTION 

Facility  ID 
Julian  date 
Shift 
Cargo  ID 
Cargo  cycle 

Discharging  carrier  type 
Discharging  carrier  ID 
Receiving  carrier  type 
Receiving  carrier  ID 
Sling/lifting  device 
Crane  operator 
Cargo  event  name 
Cargo  event  time 


Output 

DBNAME,  DBDATE ,  DBTIME 
NCDREC 
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PROGRAM  CRDBINT 
FUNCTION  WGHTCAT  (1.11) 

Purpose 

To  look  up  and  return  a  weight  code  for  a  given  cargo  ID. 
Calling  Sequence 

WGHTCAT  (CGID) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

CGID 

Integer 

- 

Input 

Cargo  ID 

Common  Blocks 

Block  Name 

WGTCOM 

Input 

Output 

WCCOUNT 

Routines  Called 


PROGRAM  CRDBINT 
FUNCTION  WCATGET  (1.111) 
Purpose 


To  determine  the  weight  category  of  a  container. 


Calling  Sequence 

WCATGET  (WEIGHT,  LONGLTR ) 


VARIABLE  TYPE 


DIMENSION  USE 


WEIGHT  Real  -  Input 

LONGLTR  Integer  -  Input 


DESCRIPTION 


Container  weight 

Equal  1  indicates  40  ft 

container. 


Common  Blocks 

Block  Name  Input  Output 

WGTCOM  WCCOUNT 


Routines  Called 


I 


PROGRAM  CRDBINT 
FUNCTION  CVOPRID  (1.12) 

Purpose 

To  convert  operator  ID  from  a  2-dlgit  number  to  a  letter  code  in  the 
range  A-L. 

Calling  Sequence 

CVOPRID  (OPERIDT) 

VARIABLE  TYPE  DIMENSION  USE  DESCRIPTION 

OPERIDT  Integer  -  Input  Operator  ID 

Common  Blocks 
NONE 


Routines  Called 


PROGRAM  CROBINT 
FUNCTION  CLASIFY  (1.13) 
Purpose 


To  determine  dlrection-of-movement,  cycle  type,  and  discharger/receiver 
break  code  for  Indicated  discharger,  receiver,  facility  ID  combination. 


Calling  Sequence 

CLASIFY  (FACILID,  DSCHXPT,  RECVXPT,  DIRMVMT,  CYCTYPE,  XPTBRK) 


VARIABLE 

DIMENSION 

USE 

DESCRIPTION 

FACILID 

Integer 

_ 

Input 

Facility  ID 

DSCHXPT 

Integer 

- 

Input 

Discharging  transporter 

RECVXPT 

Integer 

- 

Input 

Receiving  transporter 

DIRMVMT 

Integer 

- 

Output 

Forward  or  Retrograde  code 

CYCTYPE 

Integer 

- 

Output 

Cycle  type 

XPTBRK 

Integer 

- 

Output 

Transporter  break  code 

Common  Blocks 

Block  Name 

Input 

Output 

NCDREC 

NCDREC 

Routines  Called 


FCLTYPE 

XPTTYPE 
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PROGRAM  CRDBINT 
FUNCTION  FCLTYPE  (1.131) 
Purpose 


To  determine  facility  tyct. 

Calling  Sequence 

FCLTYPE  (FCNAME,  FT) 

VARIABLE  TYPE  DIMENSION  USE  DESCRIPTION 

FCNAME  Integer  -  Input  Facility  name 

FT  Integer  -  Output  Facility  type  (land  or  sea) 

Common  Blocks 

NONE 


Routines  Called 


PROGRAM  CRDBINT 
FUNCTION  XPTTYPE  (1.132) 

Purpose 

To  determine  type  of  transporter. 

Calling  Sequence 

XPTTYPE  (XPTNAME,  XT) 

VARIABLE  TYPE  DIMENSION  USE 

XPTNAME  Integer  -  Input 

XT  Integer  -  Output 

Common  Blocks 
NONE 

Routines  Called 


DESCRIPTION 

Transporter  name 
Transporter  type  (STOR,  NDDC, 
LAND,  LIGHTER) 


PROGRAM  CRSCINT  (2) 
Purpose 


To  create  selection  criteria  Intermediate  file. 
OVERLAY  (2,0) 

Routines  Called 


MINUTES 

BYCODE 

BGTBLOK 


I 
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PROGRAM  CRSCINT 
FUNCTION  MINUTES  (2.1) 

Purpose 

To  convert  hours/minutes  code  to  minutes 
Calling  Sequence 

MINUTES  (HHMM) 

VARIABLE  TYPE  DIMENSION  USE 

HHMM  Integer  -  Input 

Common  Blocks 
NONE 

Routines  Called 


DESCRIPTION 
Hours/minutes  code 


PROGRAM  CRSCINT 


FUNCTION  BYCODE  (2.2) 
Purpose 


To  test  for  a  "BY"  code  and  set  up  BY-generation  table. 
Calling  Sequence 

BYCODE  (SCFIELD,  SCNUM,  RETCODE) 


VARIABLE 

TYPE 

DIMENSION  USE 

DESCRIPTION 

SCFIELD 

Integer 

Input 

Selection  criteria 

SCNUM 

Integer 

Input 

Number  of  selection  criteria 

RETCODE 

Integer 

Output 

(1)  “YES,  set  proper  element 

of  BY-generation  table  to 
SCNUM 


(2)  =NO,  user  selected  same 
BY  number  more  than  once 

(3)  “ERR,  not  a  valid  BY 
code 

Common  Blocks 

Block  Name  Input  Output 

BST 


Routines  Called 


BYGENTB 


PROGRAM  CRSCINT 
FUNCTION  BGTBLOK  (2.3) 

Purpose 

To  see  if  BY-generation  table  is  set  up  properly. 


Callinq  Sequence 

BGTTBLOK  (DUMMY) 

VARIABLE  TYPE 

DIMENSION 

USE 

DESCRIPTION 

DUMMY 

Integer 

- 

Input 

Dummy  argument 

Common  Block 

Block  Name 

BGT 

Input 

BYGENTB 

Output 

Routines  Called 


Routines  Called 


PROGRAM  RPTORTR  (3) 

Purpose 

To  supervise  generation  of  cycle  data  statistics  report. 
OVERLAY  (3,0) 


Routines  Called 

TBLMAKR 

TBLDMPR 

GETSLCR 

SELECT 

MKSCWRD 

CVTPCCD 

WRITRPT 


PROGRAM  REPORTR 
FUNCTION  TBLMAKR  (3.1) 
Purpose 


To  construct  facility  table 
Calling  Sequence 

TBLMAKR  (FACNAME) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

FACNAME 

Integer 

- 

Input 

Faci 1 i ty 

Name 

Common  Blocks 

Block  Name 

Input 

Output 

BLANK 

DSILAST, 

OPDATE,  OPSHFT, 

FTBINDX, 

DIRMUMT,  CYTYPE, 

SGLFDEV, 

OPERID,  WGHTCAT, 

CYSTART, 

CYDURAT,  SPCLXPT 

LGTRSEQ, 

CYINTER 

Routines  Called 


PROGRAM  REPORTR 
SUBROUTINE  TBLDMPR  (3.2) 
Purpose 


To  output  Facility  table. 


Calling  Sequence 

TBLDMPR  (FACNAME) 


VARIABLE 
FACNAME 
Common  Blocks 
Block  Name 
BLANK 


TYPE 

Integer 


DIMENSION  USE 
Input 


Input 

DSILAST, 

OPSHFT, 

DIRMVMT, 

SGLFDEV, 

WGHTCAT, 

CYOURAT, 

LGTRSEQ, 


OPDATE, 

FTBINDEX, 

CYTYPE, 

OPERID, 

CYSTART, 

SPCLXPT, 

CYINTER 


Routines  Called 
NONE" 


DESCRIPTION 
Facility  name 

Output 
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PROGRAM  REPORTR 
FUNCTION  GETSLCR  (3.3) 
Purpose 


To  read  selection  criteria  from  the  intermediate  file  created  by 

CRSCINT. 


Calling  Sequence 

GETSLCR  (SELCRIT,  TITLE,  BKTSIZE,  NBUKET,  PRTHIST) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

SELCRIT 

Integer 

12 

Output 

( 1 )  Di  recti on-of-movement 

(2)  Cycle  interruption 

(3)  Sling/lifting  device 

(4)  Operator  ID 

(5)  Cycle  type 

(6)  Weight  category 

(7)  Lighter  sequence 

(8)  Special  transporter 

(9)  Cycle  start  lower  limit 

(10)  Cycle  start  upper  limit 

(11)  Cycle  duration  lower  limit 

(12)  Cycle  duration  upper  limit 

TITLE 

Integer 

4 

Output 

Card  title 

BKTSIZE 

Integer 

- 

Output 

Bin  size  for  statistics  report 

NBUCKET 

Integer 

“ 

Output 

Number  of  buckets  for  statis¬ 
tics  report 

PRTHIST 

Common  Blocks 

Block  Name 

NSCREC 

Integer 

Input 

Output 

Equals  yes  to  print 
histogram. 

Output 

NSCREC 

Routines  Called 


PROGRAM  REPORTR 


FUNCTION  SELECT  (3.4) 

Purpose 

To  select  and  return  a  set  of  cycle  times. 
Calling  Sequence 

SELECT  (SC,  CYCLES,  NCYCLES,  SDATE,  SSHIFT) 


VARIABLE 

TYPE 

DIMENSION  USE 

DESCRIPTION 

SC 

Integer 

12 

Input 

Selection  criteria  array 

(see  function  GETSLCR) 

CYCLES 

Integer 

200 

Output 

Selected  cycle  times 

NCYCLES 

Integer 

- 

Output 

Number  of  cycles  selected 

SDATE 

Integer 

- 

Output 

Selected  cycles  date 

SSHIFT 

Integer 

- 

Output 

Selected  cycles  shift 

Common  Blocks 

Block  Name 

Input 

Output 

NSCREC 

NSCREC 

BLANK 

DSILAST, 

OPDATE ,  OPSHIFT, 

FTBINDX, 

DIRMVMT, 

CYTYPE, 

SGLFTDEV,  OPERID.WGHTCAT, 
CYSTART,  CYDURAT,  SPCLXPT, 
LGHTRSEQ,  CY INTER 


Routines  Called 


PROGRAM  REPORTR 
SUBROUTINE  MKSCWRD  (3.5) 
Purpose 


To  fabricate  selection  criteria  title  words  for 

Calling  Sequence 

CALL  NKSCWRD  (SCCODE,  SCWORD) 

VARIABLE  TYPE  DIMENSION  USE 

SCCODE  Integer  12  Input 

SCWORD  Integer  10  Output 

Common  Blocks 

NONE 

Routines  Called 
WCIDENT 


subroutine  WRITRPT. 

DESCRIPTION 

Selection  criteria  code 
Selection  criteria  word 
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PROGRAM  REPORTR 
FUNCTION  WCIDENT  (3.51) 

Purpose 

To  encode  a  10-character  word  with  a  printable  weight  code  designator 
based  on  bits  set  In  input  parameter  WTCODE. 

Calling  Sequence 

WCIDENT  (WTCODE) 

VARIABLE  TYPE  DIMENSION  USE  DESCRIPTION 

WTCODE  Integer  -  Input  Container  weight  code 

Common  Blocks 
NONE 


Routines  Called 


PROGRAM  REPORTR 
SUBROUTINE  CVRPCCD  (3.6) 
Purpose 


To  convert  cycles  and  to  print  selected  cargo  cycle  data. 


Calling  Sequence 

CALL  CVTPCCD  (RCTIMES,  NCYRETR,  TITLE,  SCWORDS,  BRKKEYS,  PRTHIST , 
BRTSIZE,  NBUCKET) 


VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

RCTIMES 

Integer 

NCYRETR 

Input 

Cycle  time  indices 

NCYRETR 

Integer 

- 

Input 

Number  of  cycle  indices 

TITLE 

Integer 

4 

Input 

Title  from  selection  criteria 

record 

SCWORDS 

Integer 

10 

Input 

Selection  criteria  words 

BRKKEYS 

Integer 

3 

Input 

Facility,  date,  and  shift 

break  key 

PRTHIST 

Integer 

- 

Input 

If  yes,  then  print  histogram 

BKTSIZE 

Integer 

- 

Input 

Histogram  bin  size 

NBUCKET 

Integer 

- 

Input 

Number  of  histogram  bins 

Common  Blocks 

Block  NaLme 

Input 

Output 

BLANK  DSILAST,  OPDATE,  OPSHIFT, 

FTBINDX,  DIRMVMT,  CYTYPE, 
SGLFDEV ,  OPERID,  WGHTCAT, 
CYSTART,  CYDURAT,  SPCLXPT, 
LGTRSEQ,  CYINTR 

Routines  Called 


WCIDENT 


PROGRAM  REPORTR 
SUBROUTINE  WRITRPT  (3.7) 
Purpose 


To  call  subroutine  STATS  to  compute  statistics  (mean,  standard  deviation 
and  optionally  a  median  and  histogram)  based  on  a  set  of  input  cycle  times  and, 
when  appropriate  (i.e.,  at  each  facility  break),  shift-accumulated  statistics. 
Then  to  print  these  out  with  appropriate  headings.  This  routine  is  called  each 
time  there  is  a  break  on  facility,  date  or  shift.  An  entry  point  in  this 
routine  is  used  to  print  shift-accumulated  statistics  whenever  facility  changes. 


Calling  Sequence 


CALL  WRITRPT  (CYTIM, 

NOTIMS,  TITLE, 

SELCRI, 

BRKEYS,  HISTSW,  BINSIZ, 

NOBIN) 

VARIABLE 

TYPE 

DIMENSION 

USE 

DESCRIPTION 

CYTIM 

Integer 

200 

Input 

Selected  cycle  times 

NOT IMS 

Integer 

- 

Input 

Number  of  cycle  times 

TITLE 

Integer 

4 

Input 

Title  of  run 

SELCRI 

Integer 

10 

Input 

Selection  criteria 

BRKEYS 

Integer 

3 

Input 

(1)  Facility  ID 

(2)  Julian  date 

(3)  Shift 

HISTSW 

Integer 

- 

Input 

If  yes,  then  print  histogram 

BINS IZ 

Real 

- 

Input 

Histogram  bin  size 

NOBIN 

Integer 

- 

Input 

Number  of  histogram  bins 

Common  Blocks 

Block  Name 

Input 

Output 

SHFSTAT 

SHSUM,  SHSUMSQ, 

SHBINFR, 

SNOTIMS 

Routines  Called 


PROGRAM  REPORTR 
SUBROUTINE  STATS  (3.71) 
Purpose 


To  compute  mean,  standard  deviation,  median  and  (optinally)  histogram 
values  based  on  a  set  of  input  cycle  times.  In  addition,  to  accumulate  shift 
associated  statistics. 

Calling  Sequence 

CALL  STATS  (CYTIM,  NOTIMS,  HISTSW,  BINSIZ,  NOBIN,  XBAR,  SDEV,  MEDIAN, 
BINFREQ,  BINREL,  BINCUM,  SHIFT) 

VARIABLE  TYPE  DIMENSION  USE  DESCRIPTION 


CYTIM 

Integer 

200 

NOTIMS 

Integer 

- 

HISTSW 

Integer 

4 

BINSIZ 

Real 

- 

NOBIN 

Integer 

- 

XBAR 

Real 

- 

SDEV 

Real 

- 

MEDIAN 

Real 

- 

BINFREQ 

Real 

100 

BINREL 

Real 

100 

BINCUM 

Real 

100 

Common  Blocks 

Block  Name  Input 

SHFSTAT 


Input 

Selected  cycle  times 

Input 

Number  of  cycle  times 

Input 

Title  of  run 

Input 

Histogram  bin  size 

Input 

Number  of  histogram  bins 

Output 

Mean 

Output 

Standard  deviation 

Output 

Median 

Output 

Number  of  cycles  in  each  bin 

Output 

Relative  histogram  bin 

frequency. 

Output 

Culumative  histogram  bin 

frequency. 

Output 

SHSUM,  SHSUMSQ,  SHBINFR, 
SNOTIMS 

Routines  Called 


DSILAST 

Integer 

- 

Number  of  cycle  times 

OPDATE 

Integer 

15 

Julian  Date 

OPSHIFT 

Integer 

15 

Shift 

FTBINDX 

Integer 

15 

Facility  table  pointer 

DIRMVMT 

Integer 

700 

Di recti on-of-movement 

CYTYPE 

Integer 

700 

Cycle  type 

SGLFDEV 

Integer 

700 

Sling/lifting  device  type 

OPERID 

Integer 

700 

Operator  ID 

WGHTCAT 

Integer 

700 

Container  weight  category 

CYSTART 

Integer 

700 

Cycle  starting  time 

CYDURAT 

Integer 

700 

Cycle  duration 

SPCLXPT 

Integer 

700 

Special  transporter  type,  if  any 
Container  sequence  number 

LGTRSEQ 

Integer 

700 

CYINTER 

Integer 

700 

Cycle  interruption  code,  If  any 

COMMON  BLOCK  BST 

BYGENTB 

Integer 

6 

The  six  selection  criteria  priotry 

numbers 

COMMON  BLQCOSCBEC 

NSCREC 

Integer 

- 

Number  of  selection  criteria  records 

COMMM.BLflCK^HF_STAI 

SHSUM 

Real 

2 

Shift  sum  of  cycles  times 

SHSUMSQ 

Real 

2 

Shift  sum  of  cycles  times  squared 

SHBINFR 

Real 

(100,2) 

Histogram  bin  frequency  for  the  shift 

SNOT IMS 

Integer 

(2) 

Number  of  cycles  for  the  shift 

COMMON  BLOCK  W6TCQM 

WCCOUNT 

Integer 

7 

Number  of  containers  In  each  of  seven 

weight  categories 
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L5TGT f  CM60000 f SPUU f T500 . GST 

TASK ( TN=LOTS f TA=12345 » OS=ORISPMD f TR=TS » PI=GST ) 
COMMENT  ******  CTL .  STMTS .  ON  GEN J4MATCHR1DATA  ***** 
COMMENT.*****  RETRIEVALS  FROM  JLMT4A  ***** 

ATTACH f S2K  f  S2K260  f ID=SYS2000  f  MR= 1 . 

REQUEST f J4CIBCA f *PF . 

REQUEST f J4CDVLT f  *PF . 

REQUEST  r  J4CDVLC f  *PF . 

REQUEST  f  J4CRVLT f  *PF . 

REQUEST f J4CRVLC f *PF . 

S2K  fCR®77 . 

CATALOG fJ4CIBCAf J4CIBCA03 f ID=LOTS . 

CATALOG  f  J4CDVLT f  J4CDVLT03 f ID=LOTS . 

CATALOG  f  J4CDVLC  f  J4CDVLC03 f ID=LOTS ♦ 

CATALOG  f  J4CRVLT f  J4CRVLT03 f I D=LOTS . 

CATALOG  f  J4CRVLC f  J4CRVLC03 f ID=LOTS . 

*EOR 

USERfLOTSf  SHARED  DBN  IS  JLMT4A f 
REPORT  FILE  IS  J4CIBCA i 

LI/TITLE  L(4)fL(4)fL(4)fLC4)fL(4)fL<4)fL<4>fL(4)/ 
C1305fC1325fC1320fC1335fC1330fC1010fC1110fC1120f 
OB  C1010fC1110fC1120fC1305  UH  C1305  EXISTS? 

REPORT  FILE  IS  J4CDVLT ? 

LI/TITLE  L(4>  fL<4) fL(4) fL(4) fL<4) fL(4)/ 

C 1 720  fC1510fC1530fC1010fC1110fC1120f 
OB  CIO 10 f Cl 1 10 f Cl 120 f Cl 720  WH  C1720  EXISTS? 

REPORT  FILE  IS  J4CDVLC? 

LI/TITLE  L<4)fL<4) fL<4) fL<4) fL<4) rL<4)/ 

C2 1 20  f C20 1 0  f  C2030  fC1010fC1110fC1120f 
OB  C1010fC1110fC1120fC2120  UH  C2120  EXISTS? 

REPORT  FILE  IS  J4CRVLT  ? 

LI/TITLE  L<4) fL<4) fL(4) fL<4) fL<4)fL(4)/ 

C1820fC1510fC1530fC1010fC1110fC1120f 

OB  C1010fC1110»C1120fC1820  UH  C1820  EXISTS? 

REPORT  FILE  IS  J4CRVLC? 

LI/TITLE  L<4) fL<4) fL(4) fL(4) fL<4) fL(4)/ 

C2220  f  C20 1 0  f  C2030  fC1010fC1110fC1120f 
OB  C1010fC1110fC1120fC2220  UH  C2220  EXISTS? 

EXIT? 

*EOR 

*EOF 


•  • 


L5TGT *  CM45000 » SPUU » T 1 00 . GST 

TASK  <  TN=L0TS  *  TA=12345 * 0S=0RI SPMD , TR=TS *  P I=GST ) 
ATTACH » MATCHR 1 *  MATCHR10B JECT * I D=LOTS  *  MR= 1 . 
ATTACH * C IBCA  »J4CIBCA03 * ID=LQTS  * MR=1 . 

ATTACH  *  CDVLT *  J4CDVLT03  * ID=LOTS  *  MR= 1 . 

ATTACH  *  CDVLC  *  J4CDVLC03 » ID=LOTS  *  MR= 1 . 

ATTACH » CRVLT  *  J4CRVLT03 * IB=LOTS  *MR  =  1 ♦ 

ATTACH  *  CRVLC  *  J4CRVLC03 *  I D=LOTS  »MR=1 ♦ 
ATTACH*CGIDTS*CARGOIDFILE* ID=L0TS*MR=1 ♦ 

MATCHR1 • 


tTv 


PROGRAM  MATCHR1 

+  <  CIBCA,  CDVLT,  CDVLC  ,  CRVLT  ,  CRVLC,  OUTPUT,  001013=200. 

+  TAPE1=CIBCA,  TAPE2=CDVLT  ,  TAPE3=CDVLC , 

+  T APE4=CRVLT  ,  TAPE5=CRVLC ,  TAPE6=0UTPUT ,  TAPE7=CGIDTS ) 


N.B.  THIS  PROGRAM  MUST  BE  COMPILED  WITH  AN  * FTN *  COMMAND  WHICH  * 
INCLUDES  THE  "Z*  OPTION,  SINCE  SEVERAL  CALLS  ARE  MADE  TO  :«. 

SUBROUTINE  ENTRY  POINTS  WITHOUT  ARGUMENTS  BEING  PASSED.  * 

(CF.  FORTRAN  EXTENDED  4  MANUAL  (CDC  (34000009)  ,  P.  1-11-9)  "■# 


*  * 

*  G.  S.  TRUJILLO  * 

*  APRIL »  1978  * 

IMPLICIT  INTEGER  (A-Z) 

LOGICAL  OLD  CG  ID,  GET  CGID 


COMMON 

COMMON 

COMMON 


COMMON 

COMMON 

COMMON 

COMMON 


/TITLE/  CDATE ,  CTIME ,  DB  NAME 

/NDRRECS/  N  DL  RECS,  N  DC  RECS,  N  RL  RECS,  N  RC  RECS 

/DRTERRS/  DL  UNREF,  DC  UNREF,  RL  UNREF,  RC  UNREF, 

DL  DUPL ,  DC  DUPL,  RL  DUPL,  RC  DUPL, 

DL  INVAL,  DC  INVAL,  RL  INVAL,  RC  INVAL 

/NSSCDUP/  NSSC  DUP 

/N0RMAN1/  PRO  FID,  PRV  DATE,  PRO  SHFT 
/CGTUNIT/  NCGUNIT 

/NREPORT/  NF 

,  N  PAGE 


NREPORT 


COMMON  /TBL  UNIT/  NCIBCA,  NCDVLT ,  NCDVLC,  NCRVLT,  NCRVLC 


DATA 

h 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 


NCIBCA,  NCDVLT ,  NCDVLC,  NCRVLT ,  NCRVLC,  NREPORT 
/1,2,3,4,5,  6  / 

NRECORD  /O/,  PRO  CGID  /O/,  N  DC  NMCH,  N  RC  NMCH ,  N  DUPL  /3*0/ 
NCGUNIT  /7/ 

TOT  CG  IV,  TOT  DC  NM,  r0T  RC  NM,  TOT  DUPS,  TOT  NDUP  /5  *  0/ 


TOT  CG  IV,  TOT  DC  NM,  r0T  RC 
PRV  FID,  PRV  DATE,  PRV  SHFT 
N  PAGE,  NSSC  DUP 
DL  UNREF,  DL  DUPL,  DL  INVAL, 
DC  UNREF,  DC  DUPL,  DC  INVAL, 
RL  UNREF,  RL  DUPL,  RL  INVAL, 
RC  UNREF,  RC  DUPL,  RC  INVAL 


/3  *  1H  / 
/2  *  0/ 


/12  *  0/ 


I 


INITIALIZATION 


REWIND  NCIBCA 
REWIND  NCDVLT 


A-4 


REWIND  NCDOLT 
REWIND  NCDOLC 
REWIND  NCROLT 
REWIND  NCROLC 
REWIND  NCGUNIT 


*  READ  DATA  BASE  NAME  FROM  HEADER  RECORD 
READ(NCIBCAr 1000)  DB  NAME 

1000  FORMAT <A9/) 

IF  (DB  NAME  *NE .  1H  )  GO  TO  50 
WRITE  ( NREPORT 1 1005 ) 

1005  FORMAT (*0C I BCA  FILE  DOES  NOT  CONTAIN  TITLE  LINE  AS  RECORD  NO.  1*) 
STOP  50 

*  GET  CURRENT  DATE  AND  TIME  FROM  SYSTEM 
50  CDATE  =  DATE ( JDUMMY ) 

CTIME  =  TIME ( JDUMMY ) 

*  READ  CARGO  IDENT  FILE 
IF  (.NOT.  GET  CGID< JDUMMY) )  STOP  1 

*  - 

*  READ  A  RECORD  FROM  CIBCA  FILE 
100  READ(NCIBCA? 1010) 

+  CARGO  ID f  DIS  CAR*  DC  TYPE »  REC  CAR r 
+  RC  TYPE*  FACIL  ID*  ODATE*  SHIFT 
1010  FORMAT ( 3X » 8  ( A4 » 3X ) ) 

IF< EOF ( NCIBCA ) )  7777*  270 

*  - 

*  TEST  FOR  START  OF  NEW  GROUP 
270  IF  (FACIL  ID  .EQ.  PRO  FID  .AND.  ODATE  .EQ.  PRO  DATE 

+  .AND.  SHIFT  .EQ.  PRO  SHFT )  GO  TO  300 

*  - 

*******************************  new  group  processing  ******************* 

SEQ  =  0 

PRO  CGID  =  PRO  DSCR  =  PRO  RC  =  1H 

OUTPUT  CURRENT  FILE  SEG.  ERROR  STATS. 

IF  (NRECORD  .NE.  0) 

WRITE(NREPORT »  1015)  N  DC  NMCH *  N  RC  NMCH *  N  DUPL*  N  CG  INOL 
FORMAT ( *-*90X15*  DISCHARGING  CARRIER  NON-MATCHES*/ 

91X15*  RECEIOING  CARRIER  NON-MATCHES*/ 

91X15*  DUPLICATE  RECORDS*/ 

91X15*  INOALID  CARGO  IDENTIFIERS*) 

IF  (NSSC  DUP  .NE.  0)  WRITE ( NREPORT * 1016 )  NSSC  DUP 
1016  FORMAT (91X15*  NSSC  DUPLICATE  CODES*) 

TOT  NDUP  =  TOT  NDUP  +  NSSC  DUP 


* 

+ 

1015 

+ 

+ 

+ 


♦  ♦ 


*  •* 


*  ACCUMULATE  ERROR  TOTALS 

TOT  CG  IU  =  TOT  CG  IU  +  N  CG  INUL 

TOT  DC  NM  =  TOT  DC  NM  +  N  DC  NMCH 

TOT  RC  NM  =  TOT  RC  NM  +  N  RC  NMCH 

TOT  DUPS  =  TOT  DUPS  +  N  DUPL 


*  RESET  ERROR  COUNTERS 

N  DC  NMCH  =  N  RC  NMCH  =  N  DUPL  »  NSSC  DIJP  ■  N  CG  INUL  =  0 

*  DUMP  DISCHARGE/RECEIUE  CARRIER  TABLES 
IF  (NRECORD  . NE .  0)  CALL  TBL  DUMP 

*  OUTPUT  PAGE  HEADING 

NPAGE  =  NPAGE  +  1 

LINECNT  =0 

URITE(NREPORTf 1006)  DB  NAME t  FACIL  ID*  ODATE t  SHIFT,  CDATE » 

+  CTIMEr  NPAGE 

1006  FORMAT <  *1*8X*DATA  BASE  *A9 , 8X*FACILITY  *A4,8X*DATE  * 

+  A4»8X*SHIFT*A4»5X2<5XA9>5X*PAGE  *13// 

+  4X*SEQ*5X*DISCHARGER*5X*RECEIUER*6X*CARG0*9X*DSCH  CAR* 

+  7X*D/C  TYPE*7X*RECU  CAR*7X*R/C  TYPE*/) 


* 

* 

* 

* 


PRU  FID  =  FACIL  ID 
PRU  DATE  =  ODATE 
PRU  SHFT  =  SHIFT 


CALL  GDRDATA 
CALL  NSSC  CLR 
CALL  FDI  RSET 


SAUE  CURRENT  BLOCK  INFORMATION 
TO  DETECT  DATA  SEGMENT  BREAK 

GET  DISCHARGING/RECEIUING 
CARRIER  DATA 

CLEAR  *  NSSC  CHK-'S  COMPARISON  TABLE 
RESET  "F  DISC  ID"S  SCAN  POINTERS 


********************  END  OF  NEW  GROUP  PROCESSING 


***************  PROCESS  A  RECORD  FROM  CIBCA  FILE 


300  NRECORD  =  NRECORD  +  1 
SEQ  =  SEQ  +  1 


*  CHECK  FOR  DUPLICATE  RECORD 

IF  (CARGO  ID  .NE,  PRU  CGID  .OR.  DIS  CAR  .NE.  PRU  DSCR 
+  .OR,  REC  CAR  .NE.  PRU  RC)  GO  TO  310 

MSG1  =  10H*DUPLICATE 
MSG2  =  10HREC0RD  *** 

N  DUPL  =  N  DUPL  +  1 
GO  TO  380 


*  SAVE  CURRENT  RECORD  INFORMATION 

*  TO  ALLOW  DUPLICATE  RECORD  DETECTION 
310  PRV  CGID  =  CARGO  ID 

PRO  DSCR  =  DIS  CAR 
PRV  RC  =  REC  CAR 

*  MAKE  SURE  CARGO  ID  IS  VALID 
IF  < VLD  CG  ID < CARGO  ID))  GO  TO  305 

MSG1  =  10H**INVALID 
MSG2  *  10HCARG0  ID** 

N  CG  INVL  =  N  CG  INVL  +  1 
GO  TO  380 

*  CHECK  FOR  STORAGE  CODE 

*  AS  DISCHARGING  CARRIER  TYPE 

305  IF  (DC  TYPE  .NE.  4HSTQR )  GO  TO  320 

MSG1  =  7HST0RAGE 
GO  TO  330 

320  IF  (DC  TYPE  .NE.  4HNSSC )  GO  TO  325 
MSG1  =  NSSC  CHK (DIS  CARf  SEQ) 

GO  TO  330 

*  FIND  DISCHARGING  CARRIER  RECORD 
325  MSG1  =  F  DISC  ID(CARGO  ID»  DIS  CARf  SEQ) 

IF  ( MSG1  .EQ.  10H*N0  MATCH*)  N  DC  NMCH  =  N  DC  NMCH  +  1 

*  CHECK  FOR  STORAGE  CODE 

*  AS  RECEIVING  CARRIER  TYPE 

330  IF  (RC  TYPE  .NE.  4HSTQR)  GO  TO  340 

MSG2  =  7HST0RAGE 
GO  TO  380 

340  IF  (RC  TYPE  .NE.  4HNSSC )  GO  TO  350 
MSG2  *  NSSC  CHK (REC  CARf  SEQ) 

GO  TO  380 

*  FIND  RECEIVING  CARRIER  RECORD 
350  MSG2  =  F  RECV  ID(CARGO  ID»  REC  CARf  SEQ) 

IF  ( MSG2  .EQ.  10H*N0  MATCH#)  N  RC  NMCH  =  N  RC  NMCH  +  1 

*  PRINT  NEXT  LINE  OF  CIBCA  REPORT r 

*  AND  NEW  PAGE  HEADING  *  IF  REQUIRED 


380  IF  (LINECNT  .LE.  52)  GO  TO  400 
LINECNT  =  0 
NPAGE  =  NPAGE  +  1 

WRITE (NREPORT >1006)  DB  NAME*  FACIL  IDf  ODATE t  SHIFT i 
+  CDATE t  CTIMEr  NPAGE 

400  WRITE (NREPORT r 1100) 

+  SEQ r  MSG1 »  MSG2 r  CARGO  IDf  DIS  CARf  DC  TYPE t  REC  CARf  RC  TYPE 
LINECNT  *  LINECNT  +  1 
1100  FORMAT (lXfI6f7(5XfA10) ) 

GO  TO  100 


*********************  END  OF  CURRENT  RECORD  PROCESSING  ***************** 


*- 

* 

* 

*- 


EOF  ENCOUNTERED  ON  FILE  CIBCA- 
PRINT  RUN  STATISTICS 


7777  CONTINUE 

WRITE (NREPORT ,1015)  N  DC  NMCH  »  N  RC  NMCH »  N  DUPL,  N  CG  INVL 
CALL  TBL  DUMP 

WRITE (NREPORT , 1177)DBNAME,  CTIME ,  CDATE 

WRITE < NREPORT , 1190)NREC0RD»  TOT  DC  NH  »  TOT  RC  NM , 


+ 

TOT 

DUPS  r  TOT  1 

:g  IV,  TOT 

NDUP 

WRITE<  NREPORT ,1191) 

N 

DL  RECS 

WRITE(NREP0RT,1200) 

DL 

UNREF  t 

DL 

DUPL ,  DL 

INVAL, 

+ 

DL 

UNREF  + 

DL 

DUPL  +  DL 

INVAL 

WRITE (NREPORT  , 1192) 

N 

DC  RECS 

WRITE (NREPORT , 1200 ) 

DC 

UNREF » 

DC 

DUPL ,  DC 

INVAL, 

+ 

DC 

UNREF  + 

DC 

DUPL  +  DC 

INVAL 

WRITE ( NREPORT , 1193 ) 

N 

RL  RECS 

WRITE ( NREPORT  1 1200 ) 

RL 

UNREF  ? 

RL 

DUPL,  RL 

INVAL, 

+ 

RL 

UNREF  + 

RL 

DUPL  +  RL 

INVAL 

WRITE( NREPORT f 1194) 

N  1 

RC  RECS 

WRITE ( NREPORT » 1200) 

RC 

UNREF, 

RC 

DUPL ,  RC 

INVAL, 

+ 

RC 

UNREF  + 

RC 

DUPL  +  RC 

INVAL 

WRITE ( NREPORT  1 1199 ) 

DL 

UNREF  + 

DC 

UNREF  +  RL 

UNREF 

+ 

RC 

UNREF 

+ 

DL 

DUPL  + 

DC 

DUPL  +  RL 

DUPL 

+ 

RC 

DUPL , 

+ 

DL 

INVAL  + 

DC 

INVAL  +  RL 

INVAL 

+ 

RC 

INVAL 

Sfj 


.1 


1177  FORMAT (*1*30X*ERR0R  SUMMARY  FOR  DATA  BASE  *A9*  AT  * 

+  A9#  ON  *A10//> 

1190  FORMAT  <  #0# 

+  4X15*  TOTAL  COUNT  OF  RECORDS  IN  D/R  FILE*/ 

+  5X15*  TOTAL  FILE  DISCHARGING  CARRIER  NON-MATCHES*/ 

+  5X15*  TOTAL  FILE  RECEIVING  CARRIER  NON- MATCHES*/ 

+  5X15*  TOTAL  FILE  DUPLICATE  RECORDS*/ 

+  5X15*  TOTAL  INVALID  CARGO  IDENTIFIERS*/ 

+  5X15*  TOTAL  NSSC  CODE  DUPLICATIONS*//) 

1191  FORMAT <*ODISCHARGING  LIGHTER*//5XI5*  TOTAL  RECORDS*) 

1192  FORMAT ( *ODISCHARGING  LAND  CARRIER*//5XI5*  TOTAL  RECORDS*) 

1193  FORMAT <*ORECEIVING  LIGHTER*//5XI5*  TOTAL  RECORDS*) 

1194  FORMAT <*ORECEIVING  LAND  CARRIER*//5XI5*  TOTAL  RECORDS*) 


:-\1 


A-8 


1199  FORMAT  <  5X15*  TOTAL  NON-MATCHES*/ 

+  5X15*  TOTAL  DUPLICATE  RECORDS*/ 

+  5X15*  TOTAL  INVALID  CARGO  IDENTIFIERS*) 

1200  FORMAT <5X15*  N0N-MATCHES*/5XI5*  DUPLICATE  RECORDS*/ 

+  5X15*  INVALID  CARGO  IDENTIFIERS*/ 

+  5X15*  TOTAL  ERRORS*//) 

END 


SUBROUTINE  GDRDATA 

a**#*#*#*****########**#*#*#**###**************#**#**#**#*#***#* 
*  get  btscharging/receiuing  transporter  data  from  appropriate 


'•/  4 '/  ••’/  *•/  •**  it*  ■%/ 
-r-  •  •-'*•  ■  •  r-  /i'- 

FILES.# 


*#*######*****##*#*##******##*#****#*##***r*****##**#**********>l<>i<  ******* 


IMPLICIT  INTEGER  (A-Z) 


COMMON  /TBL  UNIT/  NCIBCA.  NCDULT »  NCDULC.  NCRULT t  NCRULC 
LOGICAL  FC  FLAG 


COMMON  /NDRRECS/  N  HL  RECS.  N  DC  RECS.  N  RL  RECS.  N  RC  RECS 


COMMON  /CDVLT/  CDLCIEK300).  CDLTID<300).  CDLTYP<300).  CDLSEG(300). 
+  NUMCDL 

COMMON  /CDVLC/  CDCCID<300).  CDCTID<300>»  CDCTYP<300).  CDCSEG<300>. 
+  NUMCDC 

COMMON  /CRULT/  CRLCID<300).  CRLTID(300>.  CRLTYP(300).  CRLSEG<300). 
+  NUMCRL 


COMMON  /CRVLC/  CRCCID<300)»  CRCTID<300)»  CRCTYP<300>.  CRCSEQ<300). 
+  NUMCRC 

DATA  FC  FLAG  /.TRUE./ 


*  CARGO  TRANS-  XPORTER  MATCHED  INPUT  FILE  1ST  CALL 

*  IDENT  PORTER  TYPE  CODE  TB  UNIT  NO.  NAME  FLAG 

NUMCDL  = 

+  REAEiTBL ( CDLCID »  CDLTID.  CDLTYP.  CDLSEG .  NCDULT r  5HCDVLT »  FC  FLAG) 
N  DL  RECS  *  N  DL  RECS  +  NUMCDL 

NUMCDC  = 

+  READTBL ( CDCCID »  CDCTID.  CDCTYP .  CDCSEQ .  NCDVLC.  5HCDULC.  FC  FLAG) 
N  DC  RECS  =  N  DC  RECS  +  NUMCDC 

NUMCRL  = 

+  READTBLtCRLCID.  CRLTID.  CRLTYP .  CRLSEQ.  NCRVLT .  5HCRULT .  FC  FLAG) 
N  RL  RECS  -  N  RL  RECS  +  NUMCRL 

NUMCRC  = 

+  READTBL ( CRCCID .  CRCTID.  CRCTYP.  CRCSEQ.  NCR’VLC  .  5HCRULC .  FC  FLAG) 
N  RC  RECS  =  N  RC  RECS  +  NUMCRC 


FC  FLAG 


FALSE 


INTEGER  FUNCTION  READTBL 

+  (CARG  TBL  t  CARR  TBL»  CRTP  TBL  >  SEQ  TBL  t  NIJN  IT  r  FNAME  t  CALL1  ) 

*  READ  ONE  D/R  FILE  INTO  A  TABLE 

************************************************************************ 

*  INPUT  VALUES  INTO  THE  CARGO*  CARRIER*  IDENTIFIER*  AND  CARRIER-TYPE* 

*  ARRAYS  FROM  THE  FILE  WHOSE  UNIT  NUMBER  IS  PASSED  AS  THE  VALUE  OF  * 

*  FORMAL  PARAMETER  * NUNIT * »  CLEARING  AS  MANY  ELEMENTS  OF  THE  " SEQTBL * 

*  ARRAY  *  IF  THE  VALUE  OF  THE  LOGICAL  PARAMETER  *  CAI..L1  *  IS  .TRUE.  * 

*  (WHICH  IT  SHOULD  BE  ONLY  THE  FIRST  TIME  *  READ  TBL"  IS  CALLED  TO  * 

*  BUILD  A  PARTICULAR  "TABLE*  (DEFINED  AS  THE  COLLECTION  OF  ARRAYS  * 

*  CONTAINING  DATA  FOR  A  PARTICULAR  CLASS  OF  CARGO  CARRIER))*  READ  AND 

*  VALIDATE  THE  HEADER  RECORD  OF  THE  PARTICULAR  FILE  BEING  READ.  * 

£ 

*  READ  FROM  THE  INDICATED  FILE  ONLY  WHILE  THE  VALUES  OF  THE  FACILITY* 

*  IDENTIFIER*  DATE*  AND  SHIFT  FIELDS  OF  THE  RECORDS  MATCH  THE  * 

*  CORRESPONDING  FIELDS  OF  THE  "CIRCA"  FILE  BEING  READ  BY  THE  MAIN  * 

*  PROGRAM*  AS  INDICATED  BY  THE  CONTENTS  OF  THE  VARIABLES  CONTAINED.  * 

*  IN  NAMED  COMMON  BLOCK  " NORMAN 1  *  (CREDIT  BEING  EXTENDED  TO  * 

*  N.  SHUSTERMAN*  ESQ.*  WHOSE  IDEA  IT  WAS  TO  PASS  THESE  VALUES  * 

*  THROUGH  COMMON*  INSTEAD  OF  DOING  SO  THROUGH  THE  USE  OF  THE  * 

*  ROUTINE'S  ARGUMENT  LIST.)  * 

************************************************************************ 


IMPLICIT  INTEGER  (A-Z) 

INTEGER  CARG  TBL(300)>  CARR  TBL(300)r  SEQ  TBL(300)r  CRTP  TBL (300) 
LOGICAL  CALLlf  VLD  CG  ID 
COMMON  /NREPORT/  NREPORT 

COMMON  /N0RMAN1/  CUR  FID>  CUR  DATEr  CUR  SHFT 


9 - 

* 

VERIFY  FILE  HEADER  ON  FIRST  CALL 

*' 

•  .. 

V* 

IF  (.NOT.  CALL1)  GO  TO  100 

READ(NUNIT »  1000)  HFNAME 

1000 

FORMAT (A5/) 

*  ‘i 

m 

IF  (EQF(NUNIT) )  50»  60 

50 

WRITE ( NREPORT » 1001 )  NUNIT 

■V- 

V  , 

1001 

FORMAT ( *-*20 ( 1H* ) *  NULL  FILE  ON  INPUT  UNIT  *12) 

STOP  2 

■.-S 

rr 

■-  - 

60 

CONTINUE 

-/ 

* 

IF  (HFNAME  .EQ.  FNAME)  GO  TO  100 

■ ‘i 

* 

WRITE(NREPORT 1 1002)  NUNIT r  FNAME r  HFNAME 

*1002 

FORMAT (*-*20( 1H*)*  WRONG  FILE  ON  UNIT  NO.  *12 

*  + 

*  EXPECTING  FILE  *A5*  —  READ  FILE  *A5) 

L 

* 

* - 

STOP  2il 

K 

A-1I 


I 


100  READTBL  =  0 

PRO  CGID  =  PRO  CARR  =  0 
DO  300  I  =  1  >  300 
SEQ  TBL(I)  =  0 
READ<NUNIT » 1010) 

+  CARG  TBL < I ) r  CARR  TBL(I)*  CRTP  TBL ( I  >  » 

+  FACIL  ID f  DATE*  SHIFT 

1010  FORMAT  <  3X » 6 ( A4  f  3X ) ) 

IF  < EOF < NUNIT ) )  777 »  200 


* 

200 

+ 


DETECT  GROUP  SEGMENT  BREAK 
IF( (FACIL  ID  .NE.  CUR  FID)  .OR.  (DATE  .NE.  CUR  DATE) 
.OR*  (SHIFT  .NE.  CUR  SHFT ) )  GO  TO  500 


#  CHECK  OALIDITY  OF  CARGO  IDENTIFIER 
IF  (.NOT.  OLD  CG  ID(CARG  TBL(I>>)  SEQ  TBL ( I )  =  -2 

*  DETECT  DUPLICATE  RECORD 

IF  (CARG  TBL(I)  .EQ.  PRO  CGID  .A.  CARR  TBL ( I )  .EQ.  PRO  CARR) 
+  SEQ  TBL(I)  =  -1 

PRO  CGID  =  CARG  TBL(I) 

PRO  CARR  *  CARR  TBL ( I ) 


300  CONTINUE 


WRITE ( NREPORT » 1050 ) NUNIT 

1050  FORMAT ( *-*20 (1H*)*  ARRAY  OOERFLOW— READING  FROM  UNIT  *12) 
STOP  3 


500  BACKSPACE  NUNIT 
777  READTBL  =1-1 


I 


INTEGER  FUNCTION  F  DISC  ID<CGID>  CRID>  CIBCASQ) 
*jK**************Jk****;fc*****J)t**:X****Jlt*********************tt**Jfc*********** 

*  CALL  SCANTAB  TO  ATTEMPT  TO  LOCATE  AN  ENTRY  IN  EITHER  OF  THE 

*  DISCHARGING  TRANSPORTER  TABLES  WHOSE  CARGO  AND  CARRIER  IDENTS 

*  MATCH  THOSE  PASSED  BY  THE  CALLER . 

********************************jfc*)fc*jf!j|t**j|t***;l:*****3ft**>it*jft*j|t*:ft*:|c*.'!t*;fc::c;|:>:<j:(j|t 


+ 

+ 

+ 

+ 


IMPLICIT  INTEGER  (A-Z) 

COMMON  /CDVLT/  CDLCID<300),  CDLTID(300),  CDLTYP(300)r 
NUMCDL 

COMMON  /CDVLC/  CDCCID<300>»  CDCTID<300)>  CDCTYP<300), 
NUMCDC 

COMMON  /CRVLT/  CRLCID<300),  CRLTID(300)>  CRLTYPC300). 
NUMCRL 

COMMON  /CRVLC/  CRCCID<300),  CRCTIIK  300 ) »  CRCTYP<300), 
NUMCRC 

DATA  LTRNAME  t  LCNAME  /  5HLGHTR  t  5HLANDC/ 

DATA  NOMATCH  /  10H*N0  MATCH*/ 

DATA  CDL  NXEL*  CDC  NXEL*  CRL  NXEL *  CRC  NXEL  /  4  * 


CDL.SEQ  ( 300 ) 
CDCSEQ ( 300 ) 
CRLSEQ ( 300 ) 
CRCSEQ ( 300) 

1  / 


* - 

200  F  DISC  ID  =  SCANTAB <  CDLCID*  CDLTID*  CDLSEQ *  NUMCDL * 

+  LTRNAME  *  CGID*  CRID  *  CIBCASQ  *  CDL  NXEL) 

IF  < F  DISC  ID  .NE.  0)  RETURN 


F  DISC  ID  =  SCANT AB ( CDCCID *  CDCTID*  CDCSEQ *  NUMCDC » 

+  LCNAME*  CGID*  CRID*  CIBCASQ*  CDC  NXEL) 

IF  <F  DISC  ID  .NE.  0)  RETURN 


F  DISC  ID  =  NO  MATCH 
RETURN 

* - 

ENTRY  F  RECV  ID 

^  4^  4^  4^  4^  ^  ^  ^  4U  ^  ^  ^  4^  4I4  ^  ^  4^  ^  4^  4^  ^  ^  ^  ^  ^  ^  ^  ^  ^  >|4  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  4^4 

^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  *  4*  *  *  *  *  4*  4*  4*  4*  4*  4*  4*  *  4*  *  4*  4"  4*  4*  4*  4"  4*  4*  4*  4*  4*  4*  *r  4*  4*  4*  4*  4* 

*  CALL  SCANTAB  TO  ATTEMPT  TO  LOCATE  AN  ENTRY  IN  EITHER  OF  THE 

*  RECEIVING  TRANSPORTER  TABLES  WHOSE  CARGO  AND  CARRIER  IDENTS 

*  MATCH  THOSE  PASSED  BY  THE  CALLER. 

}|C  Jft  Jft  jjt  Jft  Jft  Jft  Jft  3|E  )|(  3(t  Jft  Jft  Jft  3|t  )|t  Jft  Jft  3|t  !j[  Jft  J|t  3(t  Jft  !jt  Jjt  J(t  Jft  J(t  )j( )(( 3j£ )(( ]|(  J|(  3([  3(t  J|t  3|[  Jft  Jft  3(t  3ft  Jft  3ft  3(t  3ft  3ft  3ft  3ft  3ft  3(t  3ft  3jt  3ft  3ft  3ft  3ft  3(C  3jt  3ft  Jft  3ft  3ft  1ft  3jt  3ft  3ft  Jft  3jt  3ft  3ft 


400  F  DISC  ID  =  SCANTAB (CRLCID*  CRLTID*  CRLSEQ*  NUMCRL * 

+  LTRNAME *  CGID*  CRID*  CIBCASQf  CRL  NXEL) 

IF  (F  DISC  ID  .NE.  0)  RETURN 

F  DISC  ID  =  SCANTAB <CRCC ID f  CRCTID*  CRCSEQ f  NUMCRC  * 

+  LCNAME r  CGIDf  CRIDf  CIBCASQf  CRC  NXEL) 

IF  <F  DISC  ID  .NE.  0)  RETURN 
F  DISC  ID  =  NO  MATCH 
RETURN 

* - 

ENTRY  FDI  RSET 

3ft  3ft  *  3ft  3ft  3ft  3ft  3ft  3ft  *  3ft  3ft  3ft  3ft  3ft  3f(  3ft  3ft  3ft  jft  3ft  3f(  3ft  jft  3ft  3ft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft  jft 

*  RESET  'START  SCAN*  NSSC  TABLE  POINTERS.  * 

CDL  NXEL  =  CDC  NXEL  =  CRL  NXEL  =  CRC  NXEL  =  1 


~  !  IX*** 


INTEGER  FUNCTION  SCANTAB 

+  ( CARGTAB  f  CARRTAB f  SQCIBCAf  TABLIMf  T  ABNAME  r  CARGIDr  CARR  ID  f 
+  NSEQ f  STRTSCN ) 

^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ib  Ub  tb  lb  lb  ^  ^  J#  ^  ^  \b  ^  *b  %b  Ul  vV  *  b*  lb  ^  >b  -I -  sb  ^  ^  ^  lb  iL>  \b  \lf  1  L*  -Jv  tb  ^  lb  b  \b  b  b  b  b  tb  b  b  b  b  b  b  b  b  b  b 
^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ®  ^  ^  *n  *  *  ^  4p  ^  ^  ^  ^  ^  ^  ^  *p  ^  ^  ip  i^^  ^  ip  i^^  ip  ip  ^  ^  ^  ^  ^  ip  ^  ^  i^  ^  ^  ip  * ■  ^  ^  ip 

*  SCAN  APPROPRIATE  TRANSPORTER  TABLE  FOR  A  MATCH  WITH  THE  * 

*  RECORD  CURRENTLY  BEING  PROCESSED.  UPON  RETURN*  FORMAL  PARAMETER  * 

*  ■ STRT  SCN1  WILL  BE  SET  TO  THE  FIRST  ENTRY  IN  THE  GROUP  CURRENTLY  * 

*  BEING  SCANNED f  WHERE  •GROUP1  IS  DEFINED  AS  THOSE  ENTRIES  WITH  THE  * 

*  SAME  CARGO  ID.  * 

*  ♦ 

*  RETURN  A  DISPLAY-CODED  WORD  INDICATING  THE  LOCATION  WITHIN  * 

*  ONE  OF  THE  TABLES  OF  THE  SEARCHED-FOR  RECORD  AS  THE  FUNCTION  * 

*  VALUE  IF  THE  SCAN  IF  SUCCESSFUL.  * 

^  )|(  i^C  $  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  )#C  )|(  $  ^  ^  ^  ^  ^  ^  ^  ^  i^C  ]^(  ^  ^  ^ 


IMPLICIT  INTEGER  (A-Z) 

DIMENSION  CARGTAB(TABLIM) f  CARRTAB < TABLIM ) f  SQCIBCA ( TABLIM ) 
SHIFTIR(IDENT)  =  IDENT/2  .AND.  37777  77777  77777  77777  B 


IF  (CARRID  .NE.  4HST0R )  GO  TO  400 
SCANTAB  =  7HST0RAGE 
RETURN 


400  SCANTAB  ■  0 

IF  (TABLIM  .EQ.  0  .OR.  STRTSCN  .GT.  TABLIM 
+  .OR.  CARGID  .EQ.  1HU) 

NEW  STSC  ■  STRT  SCN 

CUR  CGTB  =  CARGTAB (STRT  SCN) 

DO  500  I  =  STRTSCN f  TABLIM 


RETURN 


TEST  FOR  ENTRY  ALREADY  HAVING  MATCHED 
OR  BEING  INELIGIBLE  DUE  TO  AN 
ERROR  IN  THE  ENTRY  (CF.  1 READTBL 1 ) 
IF  (SGCIBCA(I)  .NE.  0)  GO  TO  450 

IF  (CARGID  .NE.  CARGTAB(I))  GO  TO  450 
IF  (CARRID  .EQ.  CARRTAB ( I ) )  GO  TO  700 

CHANGE  POINTER  TO  START  OF  SEQUENCE 
OF  ENTRIES  WITH  SAME  CARGO  ID 
WHEN  A  BREAK  IS  FOUND 
IF  (CARGTAB(I)  . EQ.  CUR  CGTB)  GO  TO  450 
CUR  CGTB  ■  CARGTAB(I) 

NEW  STSC  =  I 


450 

500  CONTINUE 
GO  TO  800 


IF  (SHIFT1R( CARGID)  .LT.  SHIFT1R ( CARGTAB ( I ))) GO  TO  800 


♦  ♦ 


SAVE  SEQ.  NO.  OF  CIBCA  RECORD  WITHIN  TRANSPORTER  TABLE 
700  SQCIBCA ( I )  =  NSEQ 

RETURN  CODE  OF  FORM  ■<XNAME>  NN 
ENCODE ( 1 0 » 1000 » SC ANT AB)  TABNAME  t  I 
1000  FORMAT  <A5» 1X» 14) 

800  STRTSCN  *  NEW  STSC 


FUNCTION  NSSC  CHK ( IDENT  »  SEQ) 

************************************************************************ 

*  ATTEMPT  TO  FIND  IDENT  IN  TABLE  OF  SUPPOSEDLY-UNIQUE  NSSC  IDENTS  * 
***************************************************************  ********* 

COMMON  /NREPORT/  NREPORT 
COMMON  /NSSCDUP/  NSSC  DUP 

INTEGER  IDNT  TBL(200),  LSTUSED t  SEQf  EXTRACT 

EXTRACT (JWORD)  =  (JWORD  .AND.  77777  77700  00000  OOOOOB) 

+  .OR.  00000  00055  55555  5555SB 

*  - - - 

NSSC  CHK  =  4HNSSC 
IF  (LSTUSED  .EQ.  0)  GO  TO  550 

DO  500  I  -  It  LSTUSED 

ID  FR  TAB  =  IDNT  TBL(I) 

IF  (IDENT  .EQ.  EXTRACT ( ID  FR  TAB))  GO  TO  700 
500  CONTINUE 

550  LSTUSED  =  LSTUSED  +  1 

IF  (LSTUSED  .LE.  200)  GO  TO  600 
WRITE( NREPORT  *  1010 ) 

1010  FORMAT (*0*10X20 (*-*)*  OVERFLOW  IN  “NSSC  CHK‘  IDENTIFIER  TABLE*) 

STOP  4 

600  IDNT  TBL( LSTUSED)  = 

+  (IDENT  .AND.  77777  77700  00000  OOOOOB)  .OR.  SEQ 
NSSC  CHK  =  4HNSSC 
RETURN 

700  ENCODE ( 10 » 1000 » NSSCCHK )  (ID  FR  TAB  .AND.  7777B) 

1000  FORMAT (*NSSCDUP*I3) 

NERR  =  NERR  +  1 

NSSC  DUP  *  NSSC  DUP  +  1 

RETURN 

# - 

ENTRY  NSSC  CLR 

£  ^  ^|C  ^  ^  ^  ^  ^  ^  )|(  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  tf|(  )|(  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^ 

*  RESET  COUNT  OF  NO.  OF  TABLE  ELEMENTS  USED  FOR  PROCESSING  * 

*  OF  NEW  DISCHARGING/RECEIVING  TRANSPORTER  GROUP.  * 

************************************************* *********************** 


LSTUSED  =  0 


SUBROUTINE  TBL  DUMP 


GET  ALL  FOUR  TRANSPORTER  TABLES  DUMPED 


IMPLICIT  INTEGER  <A-Z> 
DIMENSION  NUMERRS( 3 ) 


COMMON  /LTRTERRS/  DL  UNREF  f  DC  UNREF f  RL  UNREF f  RC  UNREF f 

DL  DUPL  t  DC  DUPL  t  RL  DIJPL  t  RC  DUPL  f 

DL  INVAL  t  DC  INVAL  f  RL  INVAL  f  RC  INVAL. 


COMMON 

/CDVLT/ 

CDLCID( 300 >  f 
NUMCDL 

CDLTID ( 300 ) f 

CDLTYP ( 300 ) f 

CDLSEQ (300) f 

COMMON 

/CDVLC/ 

CDCCID ( 300 ) f 
NUMCDC 

CDCTID ( 300 ) f 

CDCTYF'  (  300 )  f 

CDCSEQ ( 300 ) f 

COMMON 

/CRVLT/ 

CRLCID ( 300 ) f 
NUMCRL 

CRLT ID ( 300 ) f 

CRLTYP ( 300 ) f 

CRLSEQ ( 300 ) f 

COMMON 

/CRVLC/ 

CRCC ID ( 300 ) f 
NUMCRC 

CRCTID ( 300 ) f 

CRCTYP ( 300 ) f 

CRCSEQ ( 300 ) f 

COMMON 

/PAGENUM/  N  PAGE 

IF  ( NUMCDL  +  NUMCDC  +  NUMCRL  +  NUMCRC  .EG.  0)  RETURN 

PREPARE  DUMPSTER  FOR  A  NEW  REPORT 

CALL  DPRESET 

DISCHARGING  LIGHTER  TABLE 

100  IF  (NUMCDL  .EG.  0)  GO  TO  200 

CALL  DMPSTER ( CDLC I D *  CDLTIDf  CDLTYP f  CDLSEQ f  NUMCDL » 

+  27H  DISCHARGING  LIGHTER  TABLE f  NUMERRS) 

DL  UNREF  ■  DL  UNREF  +  NUMERRS ( 1 ) 

DL  DUPL  =  DL  DUPL  +  NUMERRS (2) 

DL  INVAL  =  DL  INVAL  +  NUMERRS(3> 

DISCHARGING  LAND  CARRIER  TABLE 

200  IF  (NUMCDC  .EG.  0)  GO  TO  300 

CALL  DMPSTER ( CDCCID  f  CDCTIDf  CDCTYPf  CDCSEGr  NUMCDC r 
+  30HDISCHARGING  LAND  CARRIER  TABLEf  NUMERRS) 

DC  UNREF  =  DC  UNREF  +  NUMERRS ( 1 > 

DC  DUPL  =  DC  DUPL  +  NUMERRS  <  2 ) 

DC  INVAL  *  DC  INVAL  +  NUMERRS (3) 

RECEIVING  LIGHTER  TABLE 

300  IF  (NUMCRL  .EG.  0)  GO  TO  400 

CALL  DMPSTER(CRLCIDf  CRLTIDf  CRLTYPf  CRLSEQf  NUMCRLf 
+  26H  RECEIVING  LIGHTER  TABLEf  NUMERRS) 

RL  UNREF  =  RL  UNREF  +  NUMERRS ( 1 ) 

RL  DUPL  =  RL  DUPL  +  NUMERRS (2) 

RL  INVAL  =  RL  INVAL  +  NUMERRS (3) 


RECEIVING  LAND  CARRIER  TABLE 

400  IF  <  NUMCRC  . EG ♦  0)  RETURN 

CALL  DMPSTER  (  CRCCID  t  CRCTID»  CRCTYF:‘  t  CRCSEQ.  NUMCRC  t 
+  29H  RECEIVING  LAND  CARRIER  TABLE t 

RC  UNREF  =  RC  UNREF  +  NUMERRS ( 1 ) 

RC  DUF'L  =  RC  DUPL  +  NUMERRS  (2) 

RC  INVAL  =  RC  INVAL  +  NUMERRS (3) 


SUBROUTINE  DMPSTER 

+  (CARG  TBL.  *  CARR  TELETYPE  TBL  *  SEQ  TBL* TBL  SIZE *  HEADING  *  NER  ARAY) 

****************************;|<}K******r*********:K******>!c*****>l<*****:!<****** 

*  DUMP  ONE  OF  THE  FOUR  TRANSPORTER  TABLES.  * 

♦j***************************#*##*:^*******************:*:*^**^********** 

INTEGER  CARG  TBL ( TBL  SIZE)*  CARR  TBL ( TBL  SIZE)*  NER  ARAY ( 3  >  y 
+  SEQ  TBL  <  TBL  SIZE)*  TYPE  TBL ( TBL  SIZE)*  TBL  SIZE 

DIMENSION  HEADING  <  3 ) 

COMMON  /NORMAN 1/  FACIL  ID*  DATE*  SHIFT 
COMMON  /TITLE/  CDATE  *  CTIME  *  DB  NAME 
COMMON  /NREPORT/  NREPORT  *  NPAGE 


IF  (TBL  SIZE  .EQ.  0)  STOP  5 

FORCE  NEW  PAGE  IF  NEW  TABLE  WILL 
NOT  FIT  ENTIRELY  ON  CURRENT  PAGE 
IF  ( NLINES  .EQ.  0  .OR.  NLINES  +  TBLSIZE  +  4  .GT.  47)  NL.T.NES  *  48 

N  UNREF  *  N  DUPL  =  N  INUAL  =  0 
DO  50  I  =  1*  TBL  SIZE 

IF  (NLINES  .LE.  47)  GO  TO  25 
NLINES  =  0 
NPAGE  =  NPAGE  +  1 
WR I TE( NREPORT  *  1030 ) 

DB  NAME*  FACIL  ID*  DATE*  SHIFT*  CDATE*  CTIME*  NPAGE 
FORMAT ( *1*8X*DATA  BASE  *A9*3X*FACILITY  *A4*8X*DATE  * 

A4 *  8X*SHIFT*A4  *  5X2 ( 5XA9 ) 5X*PAGE  *13// ) 

IF  (I  .EQ.  1  .OR.  NLINES  .EQ.  0)  WRITE(NREPORT* 1020)  HEADING 
FORMAT ( 34X3A10/ 

*-*7X*SEQ*12X*CARG0  ID*1 1X*CARRIER  ID*  13X*TYPE*18X*REF*/ ) 

NO  MATCH 

IF  (SEQ  TBL(I)  .NE.  0)  GO  TO  40 

WRITE ( NREPORT  *  1001 )  I*  CARG  TBL ( I ) *  CARR  TBL ( I ) *  TYPE  TBL ( I ) 

FORMAT (5X*I5*5X*3(10X*A10)*11X* 4H - * 5X * 12H**N0  MATCH** ) 

N  UNREF  =  N  UNREF  +  1 
GO  TO  49 


DUPLICATE  RECORD 
IF  (SEQ  TBL ( I )  . GT »  0)  GO  TO  45 

IF  (SEQ  TBL ( I )  .EQ.  -2)  GO  TO  48 

WRITE( NREPORT  *  1002)  I*  CARG  TBL ( I ) *  CARR  TBL ( I ) * 
TYPE  TBL ( I > 

FORMAT (5X* 15  * 5X*3( 10X * A10) *11X*4H - *5X* 

20H**DUPLICATE  RECORD**) 

N  DUPL  =  N  DUPL  +  1 


GO  TO  49 


1003 


INVALID  CARGO 
CARO  TBL<  I  )  . 


WRITE ( NREPORT , 1 003 )  It  CARG  TBL  (  I )  ,  CARR 
TYPE  TBL ( I ) 

FORMAT ( 5X , 15 »  5X , 3 ( 10X , A 1 0  > , 1 1 X , 4H - , 5X t 

23H** INVAL ID  CARGO  I DENT*# ) 

N  INVAL  =  N  IMVAL  +  1 
GO  TO  49 


I  DENT 

CARR  TBL ( I ) 


NO  ERRORS 

45  WRITE (NREPORT 1 1000)  I,  CARG  TBL ( I )  , 

+  TYPE  TBL(I)f  SEQ  TBL  < I ) 

1000  FORMAT < 5X »I5»5X»3(10X»A10) »11X» 14) 

49  NLINES  =  NLINES  +  1 

50  CONTINUE 


CARR  TBL  (DA¬ 


TABLE  INFORMATION 

WRITE (NREPORT, 1015)  N  UNREF ,  N  DUPL,  N  INVAL 
5  FORMAT (*0* 

+  90X35 ( *-* ) / 

+  91X15*  NON-MATCHES*/ 

+  91X15*  DUPLICATE  RECORDS*/ 

+  91X15*  INVALID  CARGO  IDENTIFIERS*) 

NER  ARAY(l)  =  N  UNREF 
NER  ARAY ( 2  >  =  N  DUPL 
NER  ARAY ( 3 )  =  N  INVAL 

RETURN 


SUMMARY 


ENTRY  DP  RESET 

ill  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  |||  Ui  |^  U|  |||  ^  |||  |||  |||  U|  |i|  0|  U|  \|#  |l|  U|  |b  U|  |||  |b  |||  ^  |lp  U|  |||  ^  lO  |||  d|  |||  |||  J|  U|  ||| 

*  RESET  LINES-PER-PAGE  COUNTER  * 

^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^  |^  |^  ^  aL  ^  ^  ^  ^  ^  ^  ^  ^  ^  «L|  |X|  ^  |^  ^L|  ^  |^  |^  |^  |L  |^  ^  ^  |X|  al«  |JL|  ^  ^  |^  ^  ^  ^  ^  1^^  ^  l^i 

^  ^  ^  ^  ^  ^  ^  ^  ^  ^  ^p  ^p  ^  ^  ^p  ^  ^  ^  ^  ^  ^  ^  ^p  ^  ^  ^p  ^  ^p  ^p  ^  ^  ^  *  *  *  *  ^p  ^  ^p  ^p  ^P  ^P  ^  ^p  *  ^p  ^P  ^P  ^P  ^P  ^P  ^  ^P  4*  *  ^  ^P  4»  M’  ^P  ^P  ^P  ^P 


NLINES  =  0 


[• 


LOGICAL  FUNCTION  OLD  CG  ID(IDENT) 

W********************************************************************** 

*  SEARCH  FOR  I DENT  IN  UAL ID  CARGO- I DENT  TABLE 
*******************#*******#*******************************:**:>::***;{<  **#*:!< 

IMPLICIT  INTEGER  (A-Z) 

DIMENSION  CARGTBL ( 650 ) 

COMMON  /CGT  UNIT/  CT  UNIT 

COMMON  /NREPORT/  NREPORT 

DATA  PRU  CG  ID  /0/t  LMT  TABL  /(>/ 

SHIFTIR(ID)  =  ID/2  .A.  37777  77777  77777  77777  B 

*  - 

*  SEE  IF  IDENT  IS  IN  TABLE 

*  UAL ID  CARGO  IDENTIFIERS 
ULD  CG  ID  ■  .FALSE. 

IF  (LMT  TABL  .EQ.  0)  RETURN 

IDTMP  =  SHIFT1R ( IDENT ) 

5  DO  10  I  =  If  LMT  TABL 

IF  (IDENT  .EQ.  CARGTBL ( I ) )  GO  TO  20 
IF  (IDTMP  .LT.  SHIFTlR(CARGTBLd)  )  )  RETURN 
10  CONTINUE 
RETURN 

20  ULD  CG  ID  *  .TRUE. 

RETURN 


ENTRY  GET  CGID 

*******************#**#******##*##*##***##*#**#*****####*#*#*##*****#### 
*  READ  CARGO  ID'S  FROM  FILE  ON  UNIT  NO.  (CT  UNIT)  * 

* *********************************************************************** 
REWIND  CT  UNIT 
ULD  CG  ID  =  .FALSE. 

DO  100  I  ■  If  650 

READ ( CT  UNIT r 1000 >  CARGTBL(I) 

1000  FORMAT (A4> 

IF(EOF(CT  UNIT))  777 r  30 

30  IF ( SHIFT1R( CARGTBL ( I ) )  .GT.  SHIFT1R(PRU  CG  ID))  GO  TO  80 

WRITE (NREPORT » 1010)  CARGTBL(I)>  I 

1010  FORMAT ( *OSEQUENCE  ERROR  IN  CARGO  IDENT  FILE.  IDENT®  *A4 

+  *r  ELEMENT  NO.  *14)  • 

RETURN 

80  PRU  CG  ID  =  CARGTBL(I) 

100  CONTINUE 

WRITE(NREPORTf 1020) 

1020  FORMAT (*OOUERFLOW  IN  READING  CARGO  IDENT  TABLE.*) 

RETURN 


A-21 


L5TAG i CM60000 f SPUU  *  T500 . ATG 

TASK  <  TN=LOTS  f  TA=12345 f OS=ORISPMD f TR=TS f  PI=ATG  > 
COMMENT ♦ ****#CTL « STMTS  ON  SHPDATA4***** 

ATTACH f S2K f S2K260 f ID=SYS2000 f MR=1 . 

REQUEST f LRDY1 r  SN=SYS2 ♦ 

REQUEST  *  LRDP 1 » SN=SYS2 . 

REQUEST  fFI  f SN=SYS2 . 

REQUEST  f R1 f SN=SYS2 ♦ 

S2K f CR=77 » 

CATALOG , LRDY1 » LRDY14 f ID=LOTS * 

REWIND rLRDYl . 

COPYBF  fLRDYI ♦ 

CATALOG f  LRDP 1 fLRDP14  f ID=LOTS ♦ 

REWIND » LRDP1 ♦ 

COPYBF fLRDPI. 

CATALOG f  FI fF14  f ID=LOTS . 

REWIND » FI. 

COPYBFfFI. 

CATALOG fRI fR14f ID=LOTS. 

REWINDfRI ♦ 

CQPYBFfRI ♦ 

*EOR 

USER  *  LOTS  ? SHARED  DBN  IS  JLMT4A? 

REPORT  FILE  IS  LRDY1 ? 

LI/TITLE  L(4)fL(4)fL(4)fL(4)fL(4)fL(4)fL(4)fL(4)/ 
C1010fC1110fC1120fC1530fC1510fC1520fC1540fC1920f 
OB  C1010fC1110fC1120fC1530fC1510fC1520 
WH  (CIOIO  EQ  TCDF  OR  CIOIO  EQ  COD) 

AND  C19I0  EQ  LRDY? 

REPORT  FILE  IS  LRDP1 ? 

LI/TITLE  L(4)fL(4)fL(4)fL(4)fL(4)fL(4)fL(4)/ 
C1010fC1110fC1120fC1530fC1510fC1520fC1920f 
OB  C1010fC1110fC1120fC1530fC1510fC1520 
WH  (CIOIO  EQ  TCDF  OR  CIOIO  EQ  COD) 

AND  C1910  EQ  LRDP? 

REPORT  FILE  IS  FI? 

LI/TITLE  L(4)fL(4)fL(4)fL(4)fL(4)fL(4)/ 
C1010fC1110fC1120fC1530fC1510fC1520f 
OB  C1010fC1110fC1120fC1530fC1510fC1520 
WH  (CIOIO  EQ  TCDF  OR  CIOIO  EQ  COD) 

AND  C1820  EXISTS? 

REPORT  FILE  IS  Rl? 

LI/TITLE  L(4)fL(4)fL(4)fL(4)fL(4)fL(4)/ 
C1010fC1110fC1120fC1530fC1510fC1520f 
OB  CIOIO  fCU10fC1120fC1530fC1510fC1520 
WH  (CIOIO  EQ  TCDF  OR  CIOIO  EQ  COD) 

AND  C1720  EXISTS? 

EXIT? 


L5TAG >  CM60000 » SPUU , T500 . ATG 

TASK  <  TN=LOTS » TA=12345 » OS=ORI SPMD  »  TR=TS r  PI=ATG ) 
COMMENT ♦ ****#CTL . STMTS  ON  SHRDATA4***** 

ATTACH » S2K » S2K260  r ID=SYS2000  *  MR=1 . 

REQUEST  f  LARR2 r  SN=SYS2 . 

REQUEST » LPSN2 » SN=SYS2 . 

REQUEST  »LRDY2»SN~SYS2* 

REQUEST »LRDP2»SN=SYS2. 

S2K  f CR=77 ♦ 

CATALOG  *  LARR2 » LARR24 » ID=LOTS . 

REWIND *LARR2. 

COPYBF  f LARR2* 

CATALOG , LPSN2 » LPSN24 » I D=LOTS . 

REWIND»LPSN2. 

COPYBF *LPSN2. 

CATALOG » LRDY2 » LRDY24 » ID=LOTS . 

REWIND»LRDY2 » 

COPYBF »LRDY2. 

CATALOG  r  LRDP2 » LRDP24 » ID=LOTS . 

REWIND »LRDP2. 

COPYBF »LRDP2. 

#EOR 

USER  t LOTS  ? SHARED  DBN  IS  JLMT4A? 

REPORT  FILE  IS  LARR2? 

LI/TITLE  L(4)»L(4)»L(4)»L(4)»L(4)»L(4)»L(4)/ 
C1010»C1110»C1120»C1530f C1510f C1520»C1920» 

OB  CIOIO, ClllOf Cl 120, C1530,C1510»C1520 
WH  C1910  EQ  LARR  AND 

(CIOIO  EQ  BBCS  OR  CIOIO  EQ  ADP  OR  CIOIO  EQ  ECWY 
OR  CIOIO  EQ  LACH  OR  CIOIO  EQ  EDP) ? 

REPORT  FILE  IS  LPSN2? 

LI/TITLE  L(4),L(4),L(4),L(4),L(4),L(4),L(4)/ 
C1010,C1110,C1120,C1530,C1510,C1520,C1920, 

OB  CIOIO,  Cl  110,  CU20,C1530,C1510,C1520 
WH  C1910  EQ  LPSN  AND 

(CIOIO  EQ  BBCS  OR  CIOIO  EQ  ADP  OR  CIOIO  EQ  ECWY 
OR  CIOIO  EQ  LACH  OR  CIOIO  EQ  EDP)? 

REPORT  FILE  IS  LRDY2? 

LI/TITLE  L(4),L(4),L(4),L(4),L(4),L(4),L(4)/ 
CIOIO, C1110, Cl 120, C1530, Cl 5 10, Cl 520, Cl 920, 

OB  C1010,C1110,C1120,C1530,C1510,C1520 
WH  C1910  EQ  LRDY  AND 

(CIOIO  EQ  BBCS  OR  CIOIO  EQ  ADP  OR  CIOIO  EQ  ECWY 
OR  CIOIO  EQ  LACH  OR  CIOIO  EQ  EDP)? 

REPORT  FILE  IS  LRDP2? 

LI/TITLE  L(4),L(4),L(4),L(4),L(4),L(4),L(4)/ 
C1010,C1110,C1120,C1530,C1510,C1520,C1920, 

OB  CIOIO, Cl  110, CU20,C1530,C1510,C1520 
WH  C1910  EQ  LRDP  AND 

(CIOIO  EQ  BBCS  OR  CIOIO  EQ  ADP  OR  CIOIO  EQ  ECWY 
OR  CIOIO  EQ  LACH  OR  CIOIO  EQ  EDP)? 

EXIT? 


L5TAG » CM65000 * SPUU * T50 . ATG 

TASK(TN=L0TS*TA=12345*0S=0RISPMD*TR=TS,PI=ATG) 
ATTACH* SHRGEN»SHRGENOBJ* ID=LOTS»MR-l . 

ATTACH  *  LARR2 *  LARR24 *  ID-LOTS  *  MR- 1  * 

ATTACH  *  LPSN2 *  LPSN24 * ID-LOTS  *  MR-1 . 

ATTACH  *  LRDY2 *  LRDY24 * ID-LOTS  *  MR= 1 . 

ATTACH  *  LRDP2 *  LRDP24 *  I D-LOTS  *MR=1 ♦ 

SHRGEN* 

REWIND »0UTC2. 

COPYSBF  *0UTC2. 

REWIND*0UTI2. 

COPYSBF  *0UTI2* 

REWIND »0UTBN2. 

FILE  (  0UTBN2  *  MR! -=140 ) 

FILE(S0RT2) 

SORTMRG. 

ATTACH  *  PREV  *  PREVSHOREOBJ » ID-LOTS . 

PREV(S0RT2> . 

ATTACH » READ  *  UTILITYSH0RE24X0BJ *  ID-LOTS ♦ 
REWIND(OUT) . 

READ (OUT) . 

REWIND(OUT) . 

FILE(OUT  *MRL=1A0) 

FILE(S0RT3) 

SORTMRG. 

ATTACH  *  F  *  F14  * ID-LOTS ♦ 

ATTACH » R  *  R14  » ID=LOTS . 

REWIND»F • 

REWIND*R. 

F I LE ( F » MRL-80  *  RT-Z  *  BT-C  *  FL=80 ) 

FILE ( R  *  MRL-80 , RT-Z *  BT=C , FL-80 ) 

FILE  (  FR  *  MRL-80 » RT-Z  *  BT-C  *  FL-80 ) 

SORTMRG. 

REWIND*FR» 

COPYSBF *FR. 

ATTACH » SHPGEN *  SHPGENOBJ » ID-LOTS  *  MR- 1 . 
ATTACH»LRDY1*LRDY14*ID-L0TS*MR=1. 

ATTACH , LRDP1 » LRDP14 * ID-LOTS  *  MR-1 . 

SHPGEN ( *  »FR) . 

REWIND* 0UTC1 • 

COPYSBF  *0UTC1 . 

REWIND*0UTI1 » 

COPYSBF *0UTI1. 

REWIND*0UTBN1 « 

FILE(0UTBN1*MRL»120> 

FILE  <  S0RT1 ) 

SORTMRG. 

ATTACH  *  COMBINE  *  COMBINEOB J  *  ID-LOTS . 

COMBINE ( S0RT1 *  S0RT3 ) 

REWIND*0UTC3» 


COPYSBF  >0UTC3 . 

REWIND fOUTI3. 

COPYSBF  f 0UTI3 ♦ 

REWIND fOUTBN3 . 

FILE  <  0UTBN3 f  MRL=230 ) 

FILE  ( RES ) 

SORTMRG • 

ATTACH f SHPSHR f SHPSHRRPTOBJ f ID=LOTS . 

SHPSHR ( RES ) 

*EOR 

SORT 

FILE  f SQRT=0UTBN2 f 0UTPUT=S0RT2 

FIELD f  FACID< 1 f 10 » DISPLAY ) f DATE( 1 1  f 10  f  DISPLAY )» SHIFT <21* 10 f  DISPLAY ) 
f LI TTY ( 31  f 10*  DISPLAY  )fLITID<41f 10  f DISPLAY  >  fLITCY  <  51  f  4 »  DISPLAY ) * 

? LARR < 61 f 10  *  DISPLAY) fLPSN<71 f 10 f DISPLAY) fLRDY<81 1 10 f DISPLAY) f 
fLRDP<91f 10 f DISPLAY) fPOST  <  101  f 10  f  DISPLAY ) » RDYT ( 1 1 1  f 10 f  DISPLAY ) f 
» CRANE< 121 f 10 f DISPLAY ) f  TIME ( 131 f 10 , DISPLAY > 

KEY fFACID(Af DISPLAY )» TIME (A, DISPLAY) 

END 

*EOR 

SORT 

FILE f SORT=OUT f 0UTPUT=S0RT3 

FIELDfFACID<1f10f DISPLAY )fDAT£< 11 fIOf DISPLAY) » SHIFT ( 21 » 10 » DISPLAY) 
fLITTY  <  31  f 10  f DISPLAY )fLITID<41 f 10 f DISPLAY) fLITCY (51 f  4fDISPLAY ) t 
, LARR  <  61 f 10 f DISPLAY ) f  LPSN  <  71 f 10  f  DISPLAY ) f LRDY <  81 f 10  f  DISPLAY ) f 
f LRDP(91 » 10 » DISPLAY) fPOST< 101 f IOfDISPLAY) f RDYT < 1 1 1 f 10 » DISPLAY ) f 
» CRANE ( 121 1 10 » DISPLAY) fTIME(131f 10 r DISPLAY) fDIFF(141f 10 » DISPLAY) r 
t TYPE ( 151  f 10  »  DISPLAY ) 

KEY fLITTY ( A » DISPLAY ) , LITID  <  A  f DISPLAY ) f  TIME  <  A  f  DISPLAY ) 

END 

*EOR 

MERGE 

FILE  f  MERGE=F f  R  f  OUTPUT=FR 

FIELDfFACID<4f4fDISPLAY) fDATE< 11 f4fDI SPLAY) f SHIFT ( 18f4f DISPLAY ) f 
fLITYP<25f4fDISPLAY) fLITID(32f4fDISPLAY) fLITCY(39f4fDISPLAY) f 
f  FR ( 46  f4  f  DISPLAY ) 

KEYfFACID(AfDISPLAY) fDATE(AfDISPLAY) fSHIFT(AfDISPLAY) f 
fLITYP(AfDISPLAY) fLITID(AfDISPLAY) fLITCY(AfDISPLAY) 

END 

*EQR 

SORT 

FILE  f  S0RT=0UTBN1 f  OUTPUT=SORT 1 

FIELDfFACID< If  10 f DISPLAY) fDATE< 11 f 10 f DISPLAY) f SHIFT (21 f 10f DISPLAY) 
fLITYP<31f10fDISPLAY) fLITID(41f10fDISPLAY)fLITCY(51f10f DISPLAY) f 
fLITPS C 61 f 10 f DISPLAY )f DIR < 71 f 10 f DISPLAY) fLRDY(81 f 10 f DISPLAY) f 
fLRDP<91f 10 f DISPLAY) fLSPT( 101 f 10 f DISPLAY ) fTIME < 11 1 f 10f DISPLAY) 
KEYfLITYP<AfDISPLAY) fLITID(AfDISPLAY) fTIME(AfDISPLAY) 

END 

*EOR 

SORT 


♦  ♦ 


FILE*  SORT =0UTBN3 » OUTPUT =RES 

FIELD fSHPIIK  If  10 , DISPLAY )  , DATE <11,10 , DISPLAY ) , SHIFT <21 , 10 , DISPLAY) 
, LITTY< 31, 10, DI SPLAY ) ,LITID< 41, 10, DISPLAY ),LITCY< 51, 10, DISPLAY ) , 

, POST <61, 10, DI SPLAY ) ,FR< 71, 10, DISPLAY ) ,LRDY1< 81, 10, DISPLAY ) , 

,LRDP1 <91, 10, DISPLAY ),DIFF1< 101, 10, DISPLAY ) ,SHRID< 11 1,10, DISPLAY ) , 
, LARR< 121, 10, DISPLAY ) ,DIFF2< 131, 10, DISPLAY ) ,LPSN< 141, 10, DISPLAY) , 

, DIFF3< 151, 10, DISPLAY ) ,LRDY< 161, 10, DISPLAY ) ,DIFF4< 171, 10, DISPLAY ) , 
, LRDP< 181, 10, DISPLAY ) ,DIFF5< 191, 10, DISPLAY ) ,DIFF6< 201, 10, DISPLAY ) , 
, LI TP <211, 10, DISPLAY) , TIME < 221 , 10, DISPLAY) 

KEY, SHPID<A, DISPLAY) ,DATE<A, DISPLAY) ,SHIFT<A, DISPLAY) , 

, LITTY<A, DISPLAY) ,LITID<A, DISPLAY) , FR < A , DISPLAY ) , 

,TIME<A, DISPLAY) 


PROGRAM  SHPGEN ( LRDY1 f LRDP1 * FR1 » OUTI 1 f OUTC1 f OUTPUT f QUTBN1 f 
+  TAPE1=LRDY1 fTAPE2=LRDP1 f TAPE3=FR1 f 

+  TAPE4=0UTI1 f T  APE5=QUTC1 f TAPE6=0UTPUT f TAPE7=0UTBN1 > 

LOGICAL  NFIRSTfNFINCfNFCOMfNSTDPfNSTOPI .MATCH 

DIMENSION  K0DE<3> f NLRDY  <  6 )  f  NLRDP ( 6 ) fNFR<6> fNPAM(3> 

DIMENSION  NEND<3>  fNEOF ( 10) 

COMMON/TBLUNIT/NUNIT 1 f NUNIT2 f  NUNIT3 f NUNIT4 f NUNIT5 f NUNIT6 f NUNIT7 

INITIALIZE 

NUNIT1=1 

NUNIT2=2 

NUNIT3=3 

NUNIT4=4 

NUNIT5=5 

NUNIT6=6 

NUNIT7=7 

NFIRST=. FALSE. 

NFINC=. FALSE. 

NFCOM=. FALSE. 

NSTOP=. FALSE. 

NST0P1=. FALSE. 

10  CONTINUE 

SET  KODE  TO  READ  THREE  FILES. 

KODE( 1 )=1 
K0D£<2>=2 
K0DE<3>=3 

READ  THREE  RECORDS. 

CALL  READ <  KODE f NLRDY  f NLRDP f NFR f NLGTPS f NPAM » NFIRST f  NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE 

CALL  STOP ( NEND  f  NSTOP  f  NSTOP 1 f  KODE ) 

IF<NSTOP)  GO  TO  60 

30  CONTINUE 

COMPARE  LRDY  AND  LRDP  RECORDS. 

CALL  C0MPARE(NLRDYfNLRDPfMATCHfNFAIL1fNFAIL2) 

CHECK  FOR  A  MATCH 
IF (MATCH)  GO  TO  40 

THE  MATCH  FAILED.  SELECT  WHICH  FILE  TO  READ. 

CALL  SELECT < 1 fNFAILI fNFAIL2fK0DE> 


WRITE  THE  RECORD  THAT  DID  NOT  HAVE  A  MATCH 


CALL  RPTINC <  KODE » NLRDY , NLRDP f  NFR » NLGTPS > NPAH t NF I NC ) 

READ  A  NEW  RECORD ♦ 

CALL  READ  ( KODE » NLRDY » NLRDP » NFR , NLGTPS  >  NPAM » NF IRST  *  NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE. 

CALL  STOP ( NEND»  NSTOP  * NSTOP1 1 KODE ) 

IF<NSTQP>  GO  TO  60 

START  THE  LRDY » LRDP  COMPARISON  OVER. 

GO  TO  30 


40  CONTINUE 

A  MATCH  WAS  FOUND  ON  THE  LRDY  AND  LRDP  RECORDS. 

COMPARE  THE  LRDY  AND  THE  F/R  RECORDS. 

CALL  COMPARE <  NLRDY , NFR , MATCH , NF AIL 1 > NFA I L2 ) 

CHECK  FOR  A  MATCH. 

IF (MATCH)  GO  TO  50 

THE  MATCH  FAILED.  SELECT  WHICH  FILE  TO  READ. 

CALL  SELECT ( 2 » NFAIL1 r NFAIL2 » KODE ) 

WRITE  THE  RECORD  THAT  DID  NOT  HAVE  A  MATCH. 

CALL  RPTINC < KODE » NLRDY » NLRDP » NFR r NLGTPS , NPAM »NFINC> 

READ  A  NEW  RECORD. 

CALL  READ  <  KODE  >  NLRDY  *  NLRDP » NFR  >  NLGTPS , NPAM » NFIRST >  NEND  > 

CHECK  FOR  EOF  IN  ANY  FILE 

CALL  STOP < NEND f NSTOPfNSTOPl » KODE) 

IF<NSTOP)  GO  TO  60 

IF  LRDY  AND  LRDP  RECORDS  WERE  READ  THAN  GO  TO  LRDY  * 
LRDP  COMPARE. 

IF(K0DE(1) »EQ. l.AND.K0DE(2) .EG .2)  GO  TO  30 

ELSE  GO  TO  LRDYjFR  COMPARE 
GO  TO  40 

50  CONTINUE 

A  MATCH  WAS  FOUND  ON  THE  LRDY » LRDP >  AND  FR  RECORDS. 

CONVERT  LRDY  TO  MINS  FROM  THE  BEGINNING  OF  THE  TEST. 

CALL  CONVERT <NLRDY< 2) »NLRDY<3>  »NPAM<1>  rMINS) 

CONVERT  LRDP  TO  MINS  FROM  THE  BEGINNING  OF  THE  TEST. 

CALL  CONVERT ( NLRDY < 2 ) » NLRDY ( 3 ) *NPAM<2 ) ,MINS1 ) 


CALCULATE  LIGHTER  AT  SHIP  TIME 


LSHPT=MINS1-MINS 


WRITE  A  COMPLETE  RECORD. 

CALL  RPTCOM <  NLRDY » NLGTPS » NPAM » NFCQM » LSHPT » MINS ) 

START  OVER  WITH  READING  THREE  NEW  RECORDS. 

GO  TO  10 


60  CONTINUE 

CHECK  FOR  EOF  IN  THREE  FILES. 

IF ( NST0P1 >  GO  TO  70 

WRITE  INCOMPLETE  RECORDS. 

CALL  RPTINC ( KODE , NLRDY » NLRDP , NFR » NLGTPS » NPAM » NFINC ) 

READ  A  NEW  RECORD(S) 

CALL  READ ( KODE » NLRDY  >  NLRDP  >  NFR , NLGTPS  *  NPAM  r NFIRST  t NEND ) 

CHECK  FOR  END  CONDITION. 

CALL  STOP ( NEND » NSTOP » NST0P1 » KODE ) 

CONTINUE  STOP  PROCESS 
GO  TO  60 


70  CONTINUE 

WRITE  EOF  IN  BINARY  FILE 
DO  80  J=l»10 

NEOF ( J)=4RZE0F 
80  CONTINUE 

WR I TE ( NUN I T7 )  NEOFrLSHPT »MINS 


no  o  no  n  no  n  no  n  n  noon 


SUBROUTINE  READ ( KODE , NLRDY ,  NLRDP , NFR  > NLGTPS , NPAM , NFIRST  t NEND ) 

PURPOSE:  READS  ONE  RECORD  FROM  ANY  OF  THREE  FILES  DEPENDING 
ON  THE  VALUE  OF  KODE 

LOGICAL  NFIRST 

DIMENSION  KODE (3) t NLRDY  <  6 ) , NLRDP  <  6  >  ,  NFR  <  6  >  » NPAM ( 3 )  »  NEND ( 3 ) 

COMMON/TBLUNIT/NUNIT1 , NUNIT2,NUNIT3,NUNIT4»NUNIT5,NUNIT6,NUNIT7 

CHECK  TO  DETERMINE  IF  THE  FILES  NEED  REWINDING 
IF(NFIRST)  GO  TO  10 
REWIND  NUNIT1 
REWIND  NUNIT2 
REWIND  NUNIT3 
REWIND  NUNIT4 
REWIND  NUNIT5 
REWIND  NUNIT7 
NFIRST= . TRUE ♦ 

10  CONTINUE 

IF  KODE  EQ  1  THAN  READ  THE  LRDY  FILE 
IF  <  KODE ( 1 ) « NE • 1 )  GO  TO  30 

READ ( NUNI T 1,20)  NLRDY , NLGTPS , NPAM  < 1 ) 

20  FORMAT  <  3X , 8  <  R4 , 3X ) ) 

SAVE  EOF  KODE 
NEND  < 1 ) =NLRDY  < 1 ) 

30  CONTINUE 

IF  KODE  EQ  2  THAN  READ  THE  LRDP  FILE 
IF <K0DE<2) »NE»2)  GO  TO  50 

READ<NUNIT2»40)  NLRDP,NPAM<2> 

40  FORMAT ( 3X » 7  <  R4 , 3X ) ) 

SAVE  EOF  KODE 
NEND  <  2 ) =NLRDP ( 1 ) 

50  CONTINUE 

IF  KODE  EQ  3  THEN  READ  THE  R/F  FILE 
IF C KODE (3)»NE»3)  GO  TO  60 

RE AD < NUN I T3, 40)  NFR,NPAM<3> 

C  SAVE  EOF  KODE 

NEND<3>=NFR< 1 ) 

60  CONTINUE 
C 

RETURN 

END 
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onn  o  n  o  o  n  ooooo  n  nnnnn 


SUBROUTINE  COMPARE ( NTEST1 > NTEST2 . HATCH > NFAIL 1 > NFAIL2 ) 

purpose:  determines  if  two  records  match  on  six  match  keys. 

IF  NO  MATCH t  RETURNS  TO  THE  MAIN  PROGRAM  THE  FIRST 
MATCH  KEYS  WHERE  THE  MATCH  FAILED. 

LOGICAL  MATCH 

DIMENSION  NTEST1 (6) »NTEST2<6> 


NTEST1  HAS  THE  LRDY  RECORD. 

NTEST2  HAS  THE  LRDP  OR  F/R  RECORD. 
COMPARE  ON  THE  SIX  MATCH  KEYS. 

DO  10  J=1 .6 

IF (NTEST1 ( J ) , EQ . NTEST2<  J ) >  GO  TO  10 
THE  MATCH  FAILS. 

MATCH*. FALSE. 

NFAIL1  HAS  THE  LRDY  MATCH  KEY 
NFAIL1=NTEST1 <  J ) 

NFAIL2  HAS  THE  LRDP  OR  F/R  MATCH  KEY 
NFAIL2=NTEST2<  J) 


RETURN 


10  CONTINUE 


A  MATCH  WAS  FOUND 
MATCH*. TRUE. 


RETURN 

END 
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SUBROUTINE  SELECT < KEY , NFAIL1 *  NFAIL2 » KOBE ) 


purpose:  determines  which  record  to  read, 

DIMENSION  KODE ( 3 ) 

KEY=1  WHEN  MATCH  FAILED  ON  LRDY » LRDP  RECORDS 
KEY=2  WHEN  MATCH  FAILED  ON  LRDY  »NF/R  RECORDS 

GO  TO  ( 10  »  20 )  KEY 

10  CONTINUE 

THIS  SECTION  IS  FOR  KEY=1 ♦  A  NON-MATCH  BETWEEN  A  LRDY  RECORD 
AND  A  LRDP  RECORD. 

TEST  TO  DETERMINE  WHICH  FILE  < LRDY »LRDF‘)  TO  READ. 

IF  MATCH  KEY  LRDY  GT  MATCH  KEY  LRDP  THEN  READ  LRDP  RECORD. 

ELSE  READ  LRDY  RECORD 

KODE  < 1 ) =0 

K0DE(2>=2 

K0DE(3>=0 

IF(NFAIL1.GT.NFAIL2)  GO  TO  15 
KODE< 1 )=1 
K0DE(2)=0 
KODE (3 ) =0 
15  CONTINUE 

RETURN 


20  CONTINUE 

THIS  SECTION  IS  FOR  KEY=2.  A  NON-MATCH  BETWEEN  LRDY  AND  NF/R 
FILES. 

TEST  TO  DETERMINE  WHICH  FILE  (LRDY rNF/R  TO  READ. 

IF  MATCH  KEY  LRDY  IS  LT  MATCH  KEY  R/F  THAN  READ  LRDY 
AND  LRDP  RECORDS. 

ELSE  READ  R/F  RECORD 
K0DE(1>=1 
K0DE(2>=2 
K0DE(3)=0 

IF (NFAIL1.LT .NFAIL2)  GO  TO  30 
KODE( 1 )=0 
K0DE(2)=0 
KODE (3) =3 
30  CONTINUE 


RETURN 


SUBROUTINE  CONVERT ( NDAY  » NSHFT  r NHh  » MINS ) 


PURPOSE:  CONVERTS  DAYS, SHIFT, HRS  AND  MINS  TO  MINS  FROM  BEGINNING 
OF  THE  TEST 

DECODE < 10 > 10 » NDAY)  ND 
10  FORMAT  <  6X » 1 4 ) 

DECODE  <10*10* NSHFT )  NS 

DECODE < 10* 20 *NHM)  NH  * NM 
20  FORMAT (6X*I2*I2) 


ADD  24  TO  HRS  LT  18  ON  SHIFT  2 
IF ( NS. EQ. 2. AND.NH.LT. 17)  NH=NH+24 


CALCULATE  DAY  OF  TEST.  DAY1  EQ  0. 
ND=ND-218 

CALCULATE  MINS. 
MINS=ND*24*60+NH*60+NM 


RETURN 


SUBROUTINE  RPTINC ( KOBE  > NLRDY , NLRDP »  NFR , NLGTPS » NPAM  *  NF I NC ) 
PURPOSE:  WRITES  AN  INCOMPLETE  RECORD 
LOGICAL  NFINC 

DIMENSION  KODE <  3 )  » NLRDY <  6  >  » NLRDP (6) t NFR ( 6 ) ,NPAM(3) 

CQMMON/TBLUNIT/NUNIT1 » NUNIT2  t NUNIT3  *  NUNIT4  t NUN ITS  t NUNIT6  r NUNIT7 

IF  FIRST  CALL  THAN  PRINT  HEADER 
IF < NFINC )  GO  TO  20 
XDATE=DATE< JDUMMY) 

XTIME=TIME  <  JDUMMY ) 

WRITE<NUNIT4» 10)  XDATE  >  XT I ME 

10  FORMAT  <  IX » 18H INCOMPLETE  RECORDS  » 2  <  5X  *  A10  > »  3 (5X  »R4 ) ) 

NFINC=.TRUE. 

20  CONTINUE 


DETERMINE  IF  THE  LRDY  RECORD  SHOULD  BE  OUTPUT ♦ 

IF(K0DE(1) .NE.l)  GO  TO  40 

WRITE < NUNIT4 » 30 )  NLRDY » NLGTPS » NPAM ( 1 ) 

30  FORMAT < IX  r  4HLRDY  f 3X » 8 < R4  *  3X ) k 14 ) 

40  CONTINUE 

DETERMINE  IF  THE  LRDP  RECORD  SHOULD  BE  OUTPUT. 

IF < KODE ( 2) ♦ NE . 2 )  GO  TO  60 

WRITE<NUNIT4r50>  NLRDP»NPAM(2) 

50  FORMAT ( IX » 4HLRDP  >  3X »  7  <  R4  r  3X ) » 14 ) 

60  CONTINUE 

DETERMINE  IF  THE  F/R  RECORD  SHOULD  BE  OUTPUT. 

IF ( KODE ( 3 ) ♦ NE . 3 )  GO  TO  80 

WRITE ( NUNIT4 ? 70 )  NFR*NPAM<3> 

70  FORMAT <  IX  ? 4H  NFR > 3X r 7 < R4 > 3X > , 14 ) 

80  CONTINUE 


RETURN 


SUBROUTINE  RPTCOM <  NLRDY  ,  NLGTF'S  » NPAM » NFCOM  >  LSHPT  >  MINS  ) 

PURPOSE:  WRITES  A  COMPLETE  RECORD 

LOGICAL  NFCOM 

DIMENSION  NLRDY  <  6  >  *  NPAM  <  3 ) 

COMMON/TBLUNIT/NUNIT1 >NUNIT2*NUNIT3rNUNIT4*NUNIT5fNUNIT6»NUNIT7 

IF  FIRST  THAN  PRINT  HEADER 
IF (NFCOM)  GO  TO  20 
XDATE=DATE( JDUMMY) 

XTIME=TIME( JDUMMY) 

WRITE (NUN I T5» 10)  XDATE » XTIME 
10  FORMAT ( IX » 1 AHCOMPLETE  RECORDS »2(5X»A10)»3(5X»R4)) 

NFCOM=.TRUE. 

20  CONTINUE 


WRITE  A  COMPLETE  RECORD 

WR I TE ( NUN I T5  »  30 )  NLRDY»NLGTPS»NPAM(3) rNPAM( 1 ) ?NPAM(2) » LSHPT rMINS 
30  F0RMAT(1X»10(R4,3X) ,I4»3X>I6) 


WRITE(NUNIT7)  NLRDY >NLGTPS»NPAM(3) »NPAM( 1 ) »NPAM(2) »LSHPT,MINS 


RETURN 


SUBROUTINE  STOP ( NENB » NSTOP , NSTOP1 > KOBE ) 


purpose:  TO  DETERMINE  IF  EOF  in  any  file,  to  determine  if 

EOF  IN  ALL  FILES.  SET  NODE  TO  WRITE  INCOMPLETE  RECORDS 

LOGICAL  NSTOP » NSTOP 1 

DIMENSION  NEND<3) *  K0DE<3> 

TEST  FOR  AT  LEAST  ONE  EOF. 

IF< NSTOP )  GO  TO  60 
DO  20  J=1 ,3 

IF<NEND( J) .EQ.4R  EOF)  GO  TO  30 
NO  EOF  FOUND 
20  CONTINUE 

ALL  FILES  CONTAIN  DATA 
NSTOP=. FALSE. 

RETURN 


30  CONTINUE 

SET  NODE  FOR  AT  LEAST  ONE  EOF 
NSTQP= ♦ TRUE » 

60  CONTINUE 

CHECK  FOR  EOF  IN  LRDY  FILE.  SET  KODE. 

KODE ( 1 ) =0 

IF(NEND< 1 ) . EQ.4R  EOF)  GO  TO  80 
KODE( 1  )  =  1 
80  CONTINUE 

CHECK  FOR  EOF  IN  LRDP  FILE.  SET  KODE. 

K0DE(2)=0 

IF<NEND<2) .EQ.4R  EOF)  GO  TO  100 
KODE ( 2 ) =2 
100  CONTINUE 

CHECK  FOR  EOF  IN  THE  F/R  FILE.  SET  KODE. 

K0DE<3)=0 

IF ( NEND < 3 ) . EQ ♦ 4R  EOF)  GO  TO  120 
K0DE<3)=3 
120  CONTINUE 

CHECK  FOR  EOF  IN  ALL  FILES. 

IF <KODE< 1 ) . EQ .0 ♦ AND .KODE ( 2 ) , EQ .0 . AND .KODE ( 3 ) .EQ . 0 )  NST0P1= . TRUE . 


RETURN 


PROGRAM  SHRGEN <  LARR2 ,  LPSN2 » LRDY2 » LRDP2 > OUT 1 2  r 0UTC2 » 0UTBN2 » 

+  OUTPUT » TAPE1=LARR2 » TAPE2=LPSN2 , TAP£3=LRDY2 > 

+  TAPE4=LRDP2»TAPE5=QUTI2»TAPE6=0UTC2» 

+  T  APE7=QUTBN2 » T  APE8=0UTPUT ) 

LOGICAL  NFIRST  * NF I NC » NFCOM> NSTOP » NSTOP 1 » MATCH 

DIMENSION  KOBE (4 ) » NLARR <  7 )  » NLPSN( 7 ) » NLRDY ( 7  >  » NLRDP <7>»NTIME<4)» 

+  NEND  <  4 ) » NEOF  < 1 0 ) 

COMMON/TBLUNIT/  NUNIT1 » NUNIT2 , NUNIT3 , NUNIT4 > NUNIT5 r NUNIT6 , NUNIT7 
+  t NUNIT8 


INITIALIZE 

NUNIT1=1 

NUNIT2=2 

NUNIT3=3 

NUNIT4=4 

NUNIT5=5 

NUNIT6=6 

NUNIT7=7 

NUNIT8=8 


NFINC=. FALSE. 
NFCOM=. FALSE. 
NSTOP*. FALSE. 
NSTOP1*. FALSE. 
NFIRST*. FALSE. 


10  CONTINUE 

SET  KOBE  TO  READ  FOUR  FILES. 

K0DE<1>*1 
K0DE<2>=2 
KOBE (3) =3 
K0DE<4>*4 

READ  FOUR  RECORDS. 

CALL  READ ( KOBE » NLARR » NLPSN f NLRDY  r NLRDP f NFIRST  r NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE 

CALL  STOP  <  NEND  >  NSTOP  >  NSTOP 1  *  KOBE ) 

IF (NSTOP)  GO  TO  60 


20  CONTINUE 

COMPARE  LARR»LPSN  RECORDS 

CALL  COMPARE ( NLARR  *  NLPSN  f  M ATCH  f  NFAI L 1 r  NFA I L2  > 


CHECK  FOR  A  MATCH 
IF  (MATCH)  GO  TO  30 


on  ooo  no  oo  on  on  on  no  no  no  non  on  no  on  on 


C  THE  MATCH  FAILED.  SELECT  WHICH  FILE  TO  READ 

CALL  SELECT ( 1 fNFAILI fNFAIL2fK'0DE  > 

WRITE  THE  RECORD  THAT  DID  NOT  HAVE  A  MATCH. 

CALL  RPT INC ( KODE f NLARR f  NLPSN f NLRDY *  NLRDP  f  NF I NC ) 

READ  A  NEW  RECORD. 

CALL  READ  <  KODE f NLARR  *  NLPSN  f  NLRDY f NLRDP  *  NFIRST f NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE 
CALL  STOP  <  NEND  f  NSTOP f NSTOP 1 f KODE ) 

IF (NSTOP)  GO  TO  60 

START  THE  LARRfLPSN  COMPARISON  OVER 
GO  TO  20 


30  CONTINUE 

A  MATCH  WAS  FOUND  ON  THE  LARR  AND  LPSN  RECORDS. 

COMPARE  THE  LARR  AND  LRDY  RECORDS. 

CALL  COMPARE < NLARR f NLRDY f MATCH f NFAIL1 f NFAIL2 ) 

CHECK  FOR  A  MATCH 
IF (MATCH)  GO  TO  40 

THE  MATCH  FAILED.  SELECT  WHICH  FILE(S)  TO  READ. 

CALL  SELECT ( 2  f  NFAIL1 f NFAIL2 r KODE ) 

WRITE  THE  RECORDS  THAT  DID  NOT  HAVE  A  MATCH. 

CALL  RPTINC ( KODE f NLARR f NLPSN f NLRDY f NLRDP fNFINC) 

READ  NEW  RECORDS 

CALL  READ < KODE f NLARR f NLPSN f NLRDY f NLRDP f NFIRST f NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE. 

CALL  STOP  <  NEND  f  NSTOP  f  NSTOP 1 f  KODE  > 

IF (NSTOP)  GO  TO  60 

IF  LARRfLPSN  RECORDS  WERE  READ  THAN  GO  TO  LARRfLPSN  COMP 
IF ( KODE (l).EQ.l. AND . KODE ( 2 ) » EQ • 2 )  GO  TO  20 

ELSE  GO  TO  LARRfLPSN  COMPARE 
GO  TO  30 


40  CONTINUE 

A  MATCH  WAS  FOUND  ON  THE  LARR f LPSN f LRDY  RECORDS. 
COMPARE  THE  LARR  AND  LRDP  RECORDS. 
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CALL  COMPARE < NLARR f NLRDP » MATCH f NFAIL1 f NFAIL2 ) 


CHECK  FOR  A  MATCH. 

IF (MATCH)  GO  TO  50 

THE  MATCH  FAILED.  SELECT  WHICH  FILES  TO  READ. 

CALL  SELECT < 3 f NFAIL1 f NFAIL2 f KODE ) 

WRITE  THE  RECORD  THAT  DID  NOT  HAVE  A  MATCH. 

CALL  RPT I NC  <  KODE f NLARR f NLPSN f NLRDY f NLRDP  *  NFINC ) 

READ  A  NEW  RECORD 

CALL  READ  <  KODE f NLARR f NLPSN f NLRDY f NLRDP  f  NF IRST f NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE 

CALL  STOP ( NEND f NSTOP  f NSTOP 1 f KODE ) 

IF  LARR t LPSN f LRDY  RECORDS  WERE  READ  GO  TO  LARR  * LPSN 
COMPARE 

IF(K0DE(1) .EQ. 1 ♦ AND.K0DE<2> .EQ.2. AND.K0DE<3) .EG. 3) 

+  GO  TO  20 

ELSE  GO  TO  LARRfLRDP  COMPARE 
GO  TO  40 


50  CONTINUE 

A  MATCH  WAS  FOUND  ON  FOUR  RECORDS. 

COMPUTE  POSITION  TIMEf  READY  TIME?  LIGHTER  AT  CRANE  TIME*  AND 
MINS  FROM  START  OF  THE  TEST. 

CALL  COMPUTE  <  NLARR  f  NLPSN  >  NLRDY » NLRDP  t NT I ME ) 

WRITE  A  COMPLETE  REPORT 

CALL  RPTCOM ( NLARR » NLPSN » NLRDY  r  NLRDP  *  NTIME  > NFCOM ) 

READ  FOUR  RECORDS 
GO  TO  10 


60  CONTINUE 

CHECK  FOR  THREE  EOFS 
IF  <  NST0P1 )  GO  TO  70 

WRITE  INCOMPLETE  RECORDS 

CALL  RPTINC < KODE » NLARR f NLPSN f NLRDY f NLRDP fNFINC) 

READ  NEW  RECORD(S) 

CALL  READ <  KODE  f NLARR  f  NLPSN  f  NLRDY  f  NLRDP  f  NF I RST  f  NEND ) 


no  no  nn  nn  on 


H  ♦  ♦ 


CHECK  FOR  EOF 

CALL  STOP  <  NEND » NSTOP » NSTOP 1 > KODE ) 

CONTINUE  STOP  PROCESS 
GO  TO  60 


70  CONTINUE 

WRITE  EOF  IN  BINARY  FILE 

NTIME<4>=99999 

DO  80  J=l,10 

NEOF ( J ) =4RZE0F 
80  CONTINUE 

WRITE(NUNIT7)  NEOF»NTIME 


*  Li‘. 


on  o  on  o  non  o  on  o  o  noon 


SUBROUTINE  READ  < KODE , NLARR » NLPSN » NLRDY . NLRDP > NF IRST > NEND ) 

purpose:  reads  one  record  from  any  of  four  files  depending 

ON  THE  VALUE  OF  KODE. 

LOGICAL  NFIRST 

DIMENSION  KODE (4) t  NLARR<7)>  NLPSN<7>>  NLRDY ( 7) r  NLRDP ( 7 )  »  NEND ( 4 ) 

COMMON/TBLUNIT/NUNIT1 »NUNIT2 » NUNIT3 1 NUNIT4  rNUNITS 1 NUNIT6 » NUNIT7 
+  »NUNIT8 

CHECK  TO  DETERMINE  IF  THE  FILES  NEED  REWINDING. 

IF  (NFIRST)  GOTO  10 
REWIND  NUNIT1 
REWIND  NUNIT2 
REWIND  NUNIT3 
REWIND  NUNIT4 
REWIND  NUNIT5 
REWIND  NUNIT6 
REWIND  NUNIT7 
NFIRST=.TRUE. 

10  CONTINUE 

IF  KODE  EQ.  1  THEN  READ  THE  LARR  RECORD. 

IF  (K0DE<1) .NE.l)  GOTO  30 
READ ( NUN IT1 r20)  NLARR 
20  FORMAT <3X»7  <R4»3X)) 

SAVE  EOF  CARD 
NEND ( 1 ) =NLARR  < 1 ) 

30  CONTINUE 

IF  KODE  EQ  1  THAN  READ  THE  LPSN  FILE. 

IF  <K0DE<2>  . NE.  2)  GOTO  40 
READ(NUNIT2t20)  NLPSN 
SAVE  EOF  CODE 
NEND ( 2 ) =NLPSN ( 1 ) 

40  CONTINUE 

IF  KODE  EQ  3  THEN  READ  THE  LRDY  FILE. 

IF (K0DE(3)  .NE.  3)  GOTO  50 
READ < NUN I T3? 20)  NLRDY 
C  SAVE  EOF  CODE 

NEND  <  3 ) =NLRDY ( 1 ) 

50  CONTINUE 
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I 


SUBROUTINE  COMPARE < NTEST 1 >  NTEST2 ? MATCH ? NFAIL 1 ?  NFA IL2 ) 

purpose:  determines  if  two  records  match  on  six  match  keys. 

IF  NO  MATCH?  RETURNS  TO  THE  MAIN  PROGRAM  THE  FIRST 
MATCH  KEYS  WHERE  THE  MATCH  FAILED. 

LOGICAL  MATCH 

DIMENSION  NTEST 1 (7) »NTEST2<7> 

NTEST1  HAS  THE  LARR  RECORD. 

NTEST2  HAS  THE  LPSN  OR  LRDY  OR  LRDP  RECORD. 

COMPARE  ON  THE  SIX  MATCH  KEYS. 

DO  10  J*1 t 6 

IF(NTEST1 < J) »EQ.NTEST2< J) >  GOTO  10 

THE  MATCH  FAILS. 

MATCH*. FALSE. 

NFAIL1  HAS  THE  LARR  MATCH  KEY. 

NFAIL1=NTEST1 <  J ) 

NFAIL2  HAS  THE  LPSN  OR  LRDY  OR  LRDP  MATCH  KEY 
NFAIL2=NTEST2  <  J ) 

RETURN 

10  CONTINUE 

A  MATCH  WAS  FOUND. 

MATCH*. TRUE. 


RETURN 


SUBROUTINE  SELECT ( KEY , NFAIL1 » NFAIL2 , KOBE ) 


DIMENSION  KODE < 4 ) 

KEY=1  WHEN  MATCH  FAILED  ON  LARR, LPSN,  RECORDS. 

KEY=2  WHEN  MATCH  FAILED  ON  LARR, LRDY  RECORDS. 

KEY=3  WHEN  MATCH  FAILED  ON  LARR , LRDP  RECORDS. 

GOTO  (10,30,50)  KEY 

10  CONTINUE 

THIS  SECTION  IS  FOR  KEY=1 .  A  NON-MATCH  BETWEEN  A  LARR  AN 
LPSN  RECORD. 

TEST  TO  DETERMINE  WHICH  FILE  (LARR, LPSN  TO  READ.  IF  MATCH  KEY 
LARR  GT  MATCH  KEY  LPSN  THEN  READ  LPSN  RECORD. 

K0DE(1)=1 

KQDE(2)-0 

K0DE(3)=0 

K0DE(4)=0 

NFAIL1  HAD  LARR  NATCH  KEY.  NFAIL2  HAS  LPSN  MATCH  KEY. 

IF  MATCH  KEY  LARR  LT  MATCH  LEY  LPSN  THEN  READ  LARR  FILE. 
IF(NFAIL1.LT.NFAIL2)  GOTO  20 
KODE( 1 )=0 
K0DE(2)=2 
K0DE(3)=0 
K0DE(4)=0 
20  CONTINUE 

RETURN 


30  CONTINUE 

THIS  SECTION  IS  FOR  KEY=2 .  A  NON-MATCH  BETWEEN  THE  LARR  AND 
THE  LRDY 

TEST  TO  DETERMINE  WHICH  FILE(S)  (LARR, LPSN  OR  LRDY) 

TO  READ. 

IF  LARR, LPSN  MATCH  KEY  IS  LT  LRSY  MATCH  KEY  THEN  READ  LARR 
LPSN  RECORDS. 

K0DE(1)*1 

KQDE(2)=2 

K0DE(3)=0 

K0DE(4)=0 

NFAIL1  HAS  LARR, LPSN  MATCH  KEY  AND  NFAIL2  HAS  LRDY  MATCH  KEY. 
IF(NFAIL1 .LT.NFAIL2)  GOTO  40 

IF  LARR, LPSN  MATCH  KEY  IS  GT  LRDY  MATCH  KEY  THEN  READ  LRDY. 
K0DE(1)=0 
K0DE(2)=0 
K0DE(3>=3 
K0DE(4)=0 
40  CONTINUE 


RETURN 


50  CONTINUE 

THIS  SECTION  IS  FOR  KEY=3 ♦  A  NON-HATCH  BETWEEN  THE  LARR»LRDP 
RECORDS ♦ 

TEST  TO  DETERMINE  WHICH  FILE(S)  TO  READ.  IF  LARR  r  LF'SN  r  LRDY 

MATCH  KEY  IS  LT  LRDF*  MATCH  KEY  THEN  READ  LARR  t  LF’SN  t  LRDY  RECORDS 

K0DE(1)=1 

KODE ( 2 ) -2 

K0DE<3)=3 

K0DE<4)=0 

NFAIL1  HAS  LARR  t  LF’SN  r  LRDY  MATCH  KEY. 

NFAIL2  HAS  LRDY  MATCH  KEY. 

IF (NFAIL1.LT .NFAIL2 )  GOTO  60 

IF  LARR  t  LF’SN  f  LRDY  MATCH  KEY  IS  GT  LRDF'  MATCH  KEY  THEN  READ 
LRDP  RECORD. 

K0DE<1)=0 
K0DE(2)=0 
K0DE(3)=0 
K0DE<4)=4 
60  CONTINUE 


RETURN 


SUBROUT I NE  COMPUTE  <  NLARR >  NLPSN , NLRDY , NLRDP  >  NT IME ) 


PURPOSE:  COMPUTES  LIGHTER  POSITION  TIME*  LIGHTER  TIME »  AND 

LIGHTER  AT  CRANE  TIME  AND  TIME  FROM  BEGINNING  OF  TEST 

DIMENSION  NLARR ( 7  > » NLPSN  <  7  > » NLRDY (7) r NLRDP <  7  >  *  NT I ME  <  4  > 

CONVERT  LARR  TO  MINS 
CALL  CONVERT < NLARR f LARR) 

CONVERT  NLPSN  TO  MINS 
CALL  CONVERT  < NLRDY »LRDY) 


CONVERT  NLPSN  TO  MINS 
CALL  CONVERT <NLPSN»LPSN> 

CONVERT  NLRDP  TO  MINS 
CALL  CONVERT ( NLRDP fLRDP) 


COMPUTE  LIGHTER  IN  POSITION  TIME 
NTIME< 1 )=LPSN-LARR 

COMPUTE  LIGHTER  READY  TIME 
NTIME<2)=LRDY-LPSN 

COMPUTE  LIGHTER  AT  CRANE  TIME 
NTIME  <  3 ) =LRDP-LRDY 

SAVE  TIME  FROM  BEGINNING  OF  TEST, 
NTIME<4)=LRDY 


RETURN 


on  on  on  no  n  n  no  on  on  on  noon 


SUBROUTINE  CONVERT ( NARRAY , MINS  > 


purpose:  CONVERTS  DAYS * SHIFT* HRS  and  mins  to  mins  from 
BEGINNING  OF  THE  TEST* 

DIMENSION  NARRAY ( 7 ) 

SET  DAY 
NDAY=NARRAY ( 2 ) 

SET  SHIFT 
NSHFT =NARRA Y  <  3 ) 


SET  HRS  AND  MINS 
NHM=NARRAY  <  7 ) 


DECODE <10* lOfNDAY)  ND 
10  FORMAT  <  6X  *  14 ) 

DECODE< 10* 10*NSHFT)  NS 


DECODE  < 10*20  *  NHM )  NH  *  NM 
20  FORMAT <6X *12*12) 

ADD  24  TO  HRS  LT  18  ON  SHIFT  2 
IF  <  NS . EQ . 2 ♦ AND . NH . LT ♦ 17 )  NH=NH+24 

COMPUTE  DAY  OF  TEST.  DAY  1  EQ  0. 
ND=ND-218 


COMPUTE  MINS 

MINS=  ND*24*40  +  NH*60  +  NM 


RETURN 

END 
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SUBROUTINE  RPT INC ( KOBE r NLARR , NLPSN r NLRDY r NLRDP » NF I NC ) 

purpose:  writes  an  incomplete  record 

LOGICAL  NFINC 

DIMENSION  NODE  <  4 )  ,  NLARR ( 7 ) t NLPSN ( 7  >  >  NLRDY ( 7 )  » NLRDP ( 7 ) 

COMMON/TBLUNIT/NUNIT1 » NUNIT2  t NUNIT3  , NUNIT4 » NUN ITS  , NUNIT6 , NUNIT7 
+  f NUNIT8 

PRINT  HEADER  ON  FIRST  CALL 
IF ( NFINC )  GOTO  20 

XDATE=DATE< JDUMMY) 

XTIME=TIME< JDUMMY) 

WRITE ( NUN ITS » 10 )  XDATE »  XTIME 
10  FORMAT ( 1X»24HINC0MPLETE  SHORE  RECORDS r 2 < 5X » A10 ) ) 

NFINC= ♦ TRUE . 

20  CONTINUE 


DETERMINE  IF  THE  LARR  RECORD  SHOULD  BE  OUTPUT ♦ 

IF <KODE( 1 > .NE. 1 )  GOTO  40 
WRITE ( NUN ITS 1 30 )  NLARR 
30  FORMAT ( IX » 4HLARR » 7 < 3X » R4 > ) 

40  CONTINUE 

DETERMINE  IF  THE  LPSN  RECORD  SHOULD  BE  OUTPUT. 

IF <  KODE ( 2 ) . NE . 2 )  GOTO  60 
WRITE ( NUN ITS r 50 )  NLPSN 
50  FORMAT  < IX » 4HLPSN  f  7  <  3X  »R4  > ) 

60  CONTINUE 

DETERMINE  IF  THE  LRDY  RECORD  SHOULD  BE  OUTPUT. 

IF ( KODE ( 3 ) . NE ♦ 3 )  GOTO  80 
WRITE <NUNIT5> 70)  NLRDY 
70  FORMAT < IX  r 4HLRDY »  7  <  3X » R4 ) > 

80  CONTINUE 

DETERMINE  IF  THE  LRDP  RECORD  SHOULD  BE  OUTPUT. 

IF <KQDE< 4 ) .NE ♦ 4 )  GOTO  100 
WRITE<NUNIT5»90)  NLRDP 
90  FORMAT < IX, 4HLRDP* 7<3X,R4> ) 

100  CONTINUE 


RETURN 


SUBROUTINE  RPTCOM ( NLARR » NLPSN >  NLRDY , NLRDP *  NT I ME »  NFCOM ) 

PURPOSE?  WRITES  A  COMPLETE  RECORD 
LOGICAL  NFCOM 

DIMENSION  NLARR  (  7  >  »  NLPSN  <  7  >  » NLRDY  <  7 )  »  NLRDF1  <  7  >  » NT  I  ME  (  4 ) 

COMMON/TBLUNIT/NUNIT1 » NUNIT2  r  NUNIT3  r NUNIT4  t NUNIT5 1 NUNIT6 » NUNIT7 
+  »NUNIT8 

PRINT  HEADER  ON  FIRST  CALL 
IF (NFCOM)  GOTO  20 

XDATE=DATE  <  JDUMMY ) 

XTIME=TIME< JDUMMY) 

WRITE<  NUNIT6* 10 )  XDATE ?  XTIME 
10  FORMAT < IX  1 22HC0MPLETE  SHORE  RECORDS » 2 ( 5X » A10 ) ) 

NFCOM= » TRUE , 

20  CONTINUE 

WRITE  A  COMPLETE  RECORD 

WRITE ( NUNIT6 » 30)  NLARR » NLPSN ( 7 > » NLRDY ( 7 ) * NLRDP ( 7 ) >NTIME 
30  FORMAT < 1X» 10(3X»R4) »3<3X» 14) *3X» 16) 

WRITE < NUNIT7 )  NLARR » NLPSN < 7 ) » NLRDY (7) , NLRDP ( 7 ) , NTIME 


RETURN 


SUBROUTINE  STOP ( NEND * NSTOP » NSTOP1 » KOBE ) 

PURPOSE:  TO  DETERMINE  IF  EOF  IN  ANY  FILE.  TO  DETERMINE  IF  EOF 
IN  ALL  FILES.  SETS  NODE  TO  WRITE  INCOMPLETE  RECORDS. 

LOGICAL  NSTOP, NSTOP1 

DIMENSION  NEND ( 4 ) r  KODE ( 4 ) 

TEST  FOR  AT  LEAST  ONE  EOF 
IF (NSTOP)  GO  TO  30 
DO  10  J=1 f 4 

IF(NEND  < J> .EQ.4R  EOF)  GO  TO  20 
NO  EOF  FOUND 
10  CONTINUE 

ALL  FILES  CONTAIN  DATA 
NSTOP=. FALSE. 

RETURN 

20  CONTINUE 

SET  KODE  FOR  AT  LEAST  ONE  EOF 
NSTOP= • TRUE . 


30  CONTINUE 

CHECK  FOR  EOF  IN  LARR  FILE. 
KODE ( 1 ) =0 

IF(NEND(1) .EQ.4R  EOF)  GO  TO  40 
K0DE<1)=1 
40  CONTINUE 

CHECK  FOR  EOF  IN  LPSN  FILE. 
K0DE(2)=0 

IF<NEND<2) .EQ.4R  EOF)  GO  TO  50 
KODE ( 2 ) =2 
50  CONTINUE 

CHECK  FOR  EOF  IN  LRDY  FILE. 
KQDE(3)-0 

IF(NEND(3> .EQ.4R  EOF)  GO  TO  60 
KODE (3) =3 
60  CONTINUE 

CHECK  FOR  EOF  IN  LRDY  FILE 
K0DE<4)-0 

IF<NEND(4> .EQ.4R  EOF)  GO  TO  70 
K0DE<4)=4 
70  CONTINUE 


PROGRAM  PREV ( TAPE1 » OUT  * OUTPUT , TAPE2=0UT - TAPE6=0UTPUT ) 

purpose:  to  save  previous  lighter  type  and  previous  lrdp 

(SHORE)  ON  CURRENT  RECORD. 

DIMENSION  N < 16 ) 

N0LD=4RN0NE 

DO  20  J=l,9999 
READ<1)  <N< I) * 1=1 t 14) 

N ( 15 ) =-999 
N< 16)=4RN0NE 

IF(N( 1 )  .NE.  NOLD)  GO  TO  10 

CALL  CONVERT <N<2) »N(3) »N<9) »NLRDY> 

N(15)=NLRDY-NLRDP 
N ( 16 ) =NTYPE 

10  CONTINUE 

WRITE <  2)  <N( I ) » 1  =  1 f 16) 

NTYPE=N<4) 

NLRDP=N< 10 ) 

NOLD=N ( 1 ) 

IF(N< 1 )  . EG .  4RZE0F)  GO  TO  30 
CALL  CONVERT (N<2) » N  <  3 ) » N ( 10 ) »NLRDP) 

20  CONTINUE 
30  CONTINUE 


no  nn  n n n  non  o  n  nnon 


SUBROUTINE  CONVERT ( NBA Y , NSHFT , NHH , MINS ) 


PURPOSE:  CONVERTS  DAYS r SHIFT, HRS  AND  MINS  TO  MINS  FROM  BEGINNING 
OF  THE  TEST 

DECODE <10, lOfNDAY)  ND 
10  FORMAT <6X, 14) 

DECODE  <10,10, NSHFT )  NS 

DECODE <10, 20, NHM)  NH,NM 
20  FORMAT  <  6X ,12,12) 


ADD  24  TO  HRS  LT  18  ON  SHIFT  2 
IF<NS.EQ.2.AND.NH.LT.17)  NH=NH+24 


CALCULATE  DAY  OF  TEST.  DAY1  EQ  0. 
ND=ND-218 

CALCULATE  MINS. 
MINS=ND*24*60+NH*60+NM 


RETURN 

END 


on  oonn  no  on  o  onn  o  non  no 


PROGRAM  COMBINE <  SHIP . SHORE * 0UTI3 * 0UTC3 * 0UTBN3 * OUTPUT * 

+  TAPE1=SHIP  * TAPE  ?=SHORE *  TAPE3=0UTI3 . 

+  TAPE4=0UTC3  *  TAF  £5=0UTBN3  >  TAPE6=0UTPUT ) 

C 

LOGICAL  MISSING » MATCH* NSTQP 1  * N!  rOP*NFWD 
C 

DIMENSION  KOBE (2 ) * NSHIP <  7  >  *  NTI  El < 4 ) * NSHORE < 6 ) * NTIME2 ( 7 ) 
+  ISHIP(7)»ITIME1<4>* IwH0RE(6) * ITIME2(7) *NTIME3< 

+  * ITIME3<3> 


COMMON/TBLUNIT/NUNIT1 , NUNIT2 * NUNIT3  *NUNIT4 *  NUNIT5 * NUNIT6 

INITIALIZE 

NUNIT1=1 

NUNIT2=2 

NUNIT3=3 

NUNIT4=4 

NUNIT5=5 

NUNIT6=A 

NSTOP=. FALSE. 

NSTOP  Is3.  FALSE. 

MISSING53*  FALSE. 

SET  KOBE  TO  READ  SHIP  AND  SHORE  FILES. 

K0DE<1)=1 

K0DE<2)=2 

10  CONTINUE 

READ  A  SHIP  AND  A  SHORE  RECORD* 

CALL  READ < KOBE  * NSHIP* NSHORE* NTI ME 1 *NTIME2*NTIME3*NEND> 

CHECK  FOR  EOF  IN  ANY  FILE 

CALL  STOP  <  NEND  *  NSTOP  *  NSTOP 1  *  KOBE ) 

IF (NSTQP)  GOTO  150 


COMPARE  THE  NSHIP  AND  NSHORE  RECORDS  ON  LIGHTER  TYPE  AND 
LIGHTER  ID 

20  CONTINUE 

CALL  COMPARE  <  NSHIP  <  4 ) » NSHIP ( 5 ) *  NSHORE  <  4 ) *  NSHORE ( 5 ) * 

+  MATCH *NFAIL1 »NFAIL2> 

CHECK  FOR  A  MATCH* 

IF (MATCH)  GOTO  30 


NEND ( 2 ) * 
) 
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THE  MATCH  FAILED.  SELECT  WHICH  FILE  TO  READ. 

CALL  SELECT  <  NFAIL1 » NFAIL2  r KODE ) 

WRITE  THE  RECORD  THAT  DID  NOT  HAVE  A  MATCH. 

CALL  RPTINC( KODE  >  NSHIP. NSHORE  >  NTIME1 » NTIME2 ) 

SET  MISSING  RECORD  KODE. 

MISSING=.TRUE. 

READ  A  NEW  RECORD. 

CALL  READ ( KODE » NSHIP t NSHORE > NTIME 1 . NT IME2 > NTIME3 > NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE. 

CALL  STOP ( NEND  >  NSTOP  r NSTOP1 » KODE ) 

IF (NSTOP)  GOTO  150 

START  THE  NSHIP  »NSHORE  COMPARISION  OVER. 

GOTO  20 


30  CONTINUE 

TWO  RECORDS  WERE  FOUND  THAT  MATCH  ON  LIGHTER  TYPE  AND 
LIGHTER  ID. 

DETERMINE  FORWARD  OR  RETROGRADE  MOVEMENT. 

IF(NTIME1 ( 1 ) .EQ.4R  R)  GOTO  50 

THIS  SECTION  IS  FOR  FORWARD. 

NTIME1 <2 )  IS  LRDY  AT  SHIP 
NTIME2< 1 >  IS  LARR  AT  SHORE 

SET  FORWARD  CODE  EQ  TRUE 

NFWD=.TRUE. 

CHECK  IF  LRDY  GT  LARR 

CALL  CONVERT <NSHIP<2>  »NSHIP(3) * NTIME1 <2> » LRDY) 

CALL  CONVERT  <  NSHORE  <  2 ) »  NSHORE ( 3 ) » NT IME2  < 1 ) > LARR ) 

IF (LRDY  .GT.  LARR)  GO  TO  40 

SET  KODE  TO  READ  LRDY  (SHIP)  FILE 
KODE ( 1 ) =1 
•  K0DE(2)=0 
CHECK  FOR  MAX  LRDY 
GOTO  70 


40  CONTINUE 


WRITE  LARR< SHORE)  INCOMPLETE  RECORD »  SET  KODE  TO  READ  NEW  SHORE 
RECORD  AND  SET  MISSING  RECORD  KODE. 

MISSING= . TRUE ♦ 

KODE( 1  )=0 
K0D£(2)=2 

CALL  RPTINC<KODE»NSHIP  >NSHORE»NTIMEl »NTIME2) 

READ  A  NEW  LARR  (SHORE)  RECORD  AND  START  THR  COMPARSION  OVER . 
GOTO  10 


50  CONTINUE 

THIS  SECTION  IS  FOR  RETROGARDE. 

SET  RETROGRADE  CODE. 

NFWD=. FALSE. 

NTIME1 ( 2 )  IS  LRDY  A  SHIP. 

NTIME2< 1 )  IS  LARR  AT  SHORE. 

CALL  CONVERT <NSHORE< 2) , NSHORE ( 3 >  » NTIME2 ( 1 ) » LARR ) 
CALL  CONVERT <NSHIP< 2) * NSHIP< 3 ) > NTIME1 ( 2 ) » LRDY ) 

IF (LARR  .GT.  LRDY)  GO  TO  60 

ST  KODE  TO  READ  LARR  (SHORE)  FILE. 

KODE( 1 )=0 
K0DE(2>=2 

CHECK  FOR  MAX  LARR 
GO  TO  70 


60  CONTINUE 

WRITE  LRDY  INCOMPLETE  RECORD r  SET  KODE  TO  READ  NEW  LRDY  RECORD 
AND  SET  MISSING  RECORD  KODE. 

MISSING=.TRUE. 

KODE( 1  )=1 
K0DE<2)»0 

CALL  RPTINC(K0DE»NSHIP»NSH0RE»NTIME1 r NTIME2 ) 

READ  A  NEW  LRDY  RECORD  AND  START  THE  COMPARISION  OVER. 

GOTO  10 


70  CONTINUE 

THIS  SECTION  CHECKS  FOR  LRDY  MAX  OR  LARR  MAX. 

READ  THE  LRDY(N+1 )  OR  LARR(N+1 >  RECORD  DEPENDING  ON  THE  VALUE 
OF  KODE. 


CALL  REAIKKODE* ISHIP* ISHORE* ITIHE1 * ITIME2 > ITIME3  * NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE 

CALL  STOP  <  NEND  *  NSTOP  *  NSTOP1  *  K'QDE ) 

IF(NSTOP)  GOTO  150 

IF(NFWD)  GOTO  80 

THIS  SECTION  IS  FOR  RETROGRADE 

CALL  COMPARE < NSHIP <  4 )  * NSHIP ( 5 )  * ISH0RE<4>  * ISHORE < 5 >* MATCH  * 

+  NF1 *NF2 ) 

GOTO  90 

80  CONTINUE 

THIS  SECTION  IS  FOR  FORWARD 

CALL  COMPARE < ISHIP <  4  >  * ISHIP  < 5 ) * NSHORE ( 4 ) * NSHORE ( 5 ) * MATCH rNFl * NF2 > 
90  CONTINUE 

CHECK  FOR  MATCH  ON  LIGHTER  TYPE  AND  LIGHTER  ID 
IF (MATCH)  GOTO  100 

IF  NON-MATCH  ACCEPT  RECORD 
GOTO  120 


100  CONTINUE 

A  MATCH  WAS  FOUND* 

CHECK  FOR  FORWARD  OR  RETROGRADE  MOVEMENT. 

IF ( .NOT . NFWD)  GO  TO  110 

THIS  SECTION  IS  FOR  FORWARD. 

ITIME1 <2)  EQ  LRDY  AT  SHIP 
NTIME2< 1 )  EQ  LARR  AT  SHORE 

IF  LRDY (N+l >  GT  LARR<M)  ACCEPT  RECORD 

CALL  CONVERT <ISHIP<2)»ISHIP<3)*ITIME1<2)*LRDY> 

CALL  CONVERT (NSH0RE(2) »NSH0RE<3) ?NTIME2( 1 ) *LARR> 

IF(LRDY  .GT.  LARR)  GO  TO  120 

WRITE  AN  INCOMPLETE  LRDY  RECORD 

CALL  RPTINC < KODE f NSHIP* NSHORE r NT I ME 1 r NTIME2 > 

UPDATE  CURRENT  LRDY  RECORD 

CALL  UPDATE<K0DEfISHIPfNSHIPfISH0REfNSH0REfITIME1fNTIME1f 
+  ITIME2»NTIME2f ITIME3* NTIME3) 

SET  MISSING  RECORD  CODE. 

MISSING=.TRUE. 

READ  NEW  LRDY  RECORD 
GOTO  70 


110  CONTINUE 

THIS  SECTION  IS  FOR  RETROGRADE 
NTIME1 ( 2 )  EG  LRDY  AT  SHIP 
ITIME2(2)  EG  LARR  AT  SHORE 

IF  LARR ( N+l )  GT  LRDY(M)  ACCEPT  RECORD 

CALL  CONVERT ( ISH0RE<2) r ISH0RE<3) t ITIME2< 1 ) »LARR> 

CALL  CONVERT ( NSHIP ( 2 ) * NSHIP ( 3 ) >NTIME1<2)  » LRDY ) 

IF (LARR  .GT.  LRDY)  GO  TO  120 

WRITE  AN  INCOMPLETE  LARR  RECORD 

CALL  RPTINC (KODE » NSHIP  * NSHORE  f  NT I ME 1  *  NTIME2 ) 

UPDATE  CURRENT  LARR  RECORD 

CALL  UPDATE < KODE »  I SHI P > NSHIP » ISHORE* NSHORE »  ITIME1 r NTIME1 » 
+  ITIME2  »NTIME2 » ITIME3  >NTIME3 ) 

SET  MISSING  KODE 
MISSING*. TRUE. 

READ  NEW  LARR  RECORD 
GOTO  70 


120  CONTINUE 

A  RECORD  HAS  BEEN  COMBINED. 

COMPUTE  LIGHTER  SUCCESSION  TIME  AND  LIGHTER  TRANSIT  TIME 
CALL  COMPUTE < NSHIP fNLHOREr NT IME1 r NTIME2 * NFWD » MISSING r 
+  NTIME3 ) 

INITIALIZE  MISSING  RECORD  CODE 
MISSING*. FALSE. 

CALL  CONVERT <NSHIP<2> * NSHIP <  3  >  fNTIMEl (2 ) rNSORT ) 


WRITE  A  COMPLETE  RECORD 

CALL  RPTCOM <  NSHIP  * NSHORE eNTIMEl r NTIME2 , NTIME3  r NSORT ) 

SET  KODE  TO  READ  NEW  RECORDS 
IF(NFWD)  GOTO  130 

SET  KODE  FOR  RETROGRADE 

KODE( 1 )=0 

K0DE<2)=0 

CALL  UPDATE ( KODE » ISHIP  *  NSHIP , ISHORE  r  NSHORE  * ITIME1 * 
+  NTIMEl»ITIME2»NTIME2fITIME3fNTIME3) 

KODE< 1 )*1 
K0DE<2)=0 


on  non  on  no  no  on  n  non 


GOTO  140 
C 

130  CONTINUE 

C  SET  NODE  FOR  FORWARD 

K0DE< 1 ) =1 
KQDE<2>=0 
C 

CALL  UPDATE ( KODE »  ISHIP»NSHIP»  I  SHORE » NSHORE f  ITIME1 * NTIME1 , 
+  ITIME2»NTIME2,ITIME3»NTIME3> 

KODE  < 1 ) =0 
KODE ( 2 ) =2 
140  CONTINUE 

C  GOTO  BEGINNING  OF  PROGRAM 

GOTO  10 


150  CONTINUE 

CHECK  FOR  EOF  IN  TWO  FILES 
IF ( NST0P1 )  GOTO  160 

WRITE  AN  INCOMPLETE  RECORD 

CALL  RPTINC(K0DE»NSHIP,NSH0RE»NTIME1,NTIME2> 

READ  A  NEW  RECORD 

CALL  READ  <  KODE  »  NSH I P » NSP  )RE  » NT I ME 1 »  NT I ME2  r  NT I ME3  r  NEND ) 


CHECK  FOR  EOF  IN  BOTH  FILES. 

CALL  STOP ( NEND » NSTOP » NST0P1 ? KODE ) 

CONTINUE  STOP  PROCESS 
GOTO  150 


160  CONTINUE 

WRITE  EOF  IN  BINARY  FILE 
DO  170  J=1 *  7 

NSHIP< J)=4RZE0F 
NTIME2< J)=9999 
170  CONTINUE 

WRITE (NUN ITS)  NSHIP,  <NSHIP< J>  > J=1 >3) r NTIME2< 1 ) > NSHIP < 1 ) > 
+  <NSHIP< J) »NTIME2< J) r J=1 , 4 ) ,NTIME2< 1 ) r NSHIP( 1 > 

C 

END 
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SUBROUTINE  READ  ( KODE » NSHIP , NSHORE r NTIME1 > NTIME2 , NTIME3 r  NENB ) 


PURPOSE:  TO  READ  A  RECORD  FROM  THE  SHIP  AND/OR  SHORE  FILE 
LOGICAL  FIRST 

DIMENSION  KODE ( 2  >  »  NSHIP  <  7 ) r NSHORE ( 6 ) > NTIME1 ( A ) > NT IME2 ( 7 ) t NEND ( 2 ) 
+  f NTIME3  <  3 ) 

COMMON/TBLUNIT/NUNIT1 1 NUNI T2 1 NUNIT3  r  NUNIT4 » NUN ITS » NUNIT6 

DATA  FIRST/6H.TRUE./ 

REWIND  FILES  FIRST  TIME  THRU 
IF <  .NOT .  FIRST)  GO  TO  10 
REWIND  NUNIT1 
REWIND  NUNIT2 
REWIND  NUNIT3 
REWIND  NUNIT4 
REWIND  NUNIT5 
FIRST  =  .FALSE. 

10  CONTINUE 

IF  KODE < 1 )  =  1  READ  SHIP  FILE 
IF<  KODE ( 1 )  .NE.  1)  GO  TO  20 
READ(NUNITl)  NSHIP»NTIME1 
NEND ( 1 ) =NSHIP  < 1 ) 

20  CONTINUE 

IF  K0DE<2>=2  READ  SHORE  FILE 
IF ( KODE < 2 ) . NE . 2 )  GO  TO  30 

READ(NUNIT2)  NSHORE » NTIME2 r NSPACE f NTIME3 ( 2 ) r NTIME3 ( 3 ) 

NEND ( 2 ) =NSHORE  < 1 ) 

30  CONTINUE 
RETURN 
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SUBROUTINE  COMPARE <N1 »N2» N3»N4 
|  +  »MATCH » NFAIL1 »NFAIL2> 

purpose:  determines  if  two  records  match  on  two  match  keys 

(LIGHTER  TYPE  AND  LIGHTER  ID). 

LOGICAL  MATCH 

DIMENSION  NTEST1 (2) »NTEST2< 2 ) 

NTEST1 < 1 )=N1 
NTEST1 (2)=N2 
NTEST2(1)*N3 
NTEST2(2)*N4 
NTEST1  HAS  NSHIP  KEYS 
NTEST2  HAS  NSHORE  KEYS 

DO  10  J=1 » 2 

IF (NTEST1 ( J) *EQ»NTEST2( J) >  GOTO  10 
THE  MATCH  FAILS 
MATCH*. FALSE. 

NFAIL1  HAS  THE  NSHIP  MATCH  KEY 
NFAIL1*NTEST1< J) 

NFAIL2  HAS  THE  NSHORE  MATCH  KEY 
NF  A I L2=NTEST2  <  J ) 

RETURN 

10  CONTINUE 


A  MATCH  HAS  BEEN  FOUND 
MATCH*. TRUE. 


RETURN 
END 


C: 


u 


oooo  no  non 


SUBROUTINE  SELECT <  NFAIL 1 »  NFAIL2 » KOBE ) 


purpose:  determines  which  record  to  read 

DIMENSION  KOBE (2) 

TEST  TO  DETERMINE  WHICH  FILE  (NSHIP, NSHORE)  TO  READ. 

K0DE<1>=1 
K0DE(2)*0 

NFAIL1  HAS  NSHIP  MATCH  KEY. 

NFAIL2  HAS  NSHORE  MATCH  KEY. 

IF  NSHIP  MATCH  KEY  LT  NSHORE  MATCH  KEY  THEN  READ  NSHIP  RECORD 
IF(NFAIL1 .LT .NFAIL2)  GOTO  10 
KODE( 1 )=0 
K0DE<2)=2 
C 
C 

10  CONTINUE 
C 
C 

RETURN 


I 


no  no  o  o  o  o  o  o  o  noo  o  o  ooooo 


S 


SUBROUTINE  COMPUTE ( NSHIP » NSHORE >  NTIME1 » NTIME2 r NFWD , MISS ING  > 
+NTIME3) 

purpose:  to  compute  lighter  succession  time  at  shore. 

TO  COMPUTE  LIGHTER  UNDER  WAY  TIME 
TO  SAVE  PREVIOUS  LIGHTER  TYPE 

LOGICAL  MISSINGrNFUD 

DIMENSION  NSHIP<7) »NSH0RE<6) >NTIME1<4) »NTIME2<7)  >NTIME3<3) 

IF( .NOT. MISSING)  GO  TO  10 
MISSING-. TRUE. 


10  CONTINUE 

IF (NFWD)  GO  TO  20 

CALCULATE  LIGHTER  READY  AT  SHIP  TIME. 

CALL  CONVERT < NSHIP ( 2 ) » NSHIP (3) rNTIMEl (2) t LRDY ) 
CALCULATE  LIGHTER  READY  TO  DEPART  SHORE  TIME. 
CALL  CONVERT ( NSHORE < 2 ) » NSHORE (3) »NTIME2<4) »LRDP) 
CALCULATE  LIGHTER  WNDER  WAY  TIME 
NTIME3< 1 )»LRDY-LRDP 
GO  TO  30 

20  CONTINUE 

CALCULATE  LIGHTER  ARRIVAL  AT  THE  SHORE  TIME 
CALL  CONVERT  <  NSHORE  <  2 ) » NSHORE ( 3  >  r NT IME2 ( 1 > » L ARR ) 
CALCULATE  LIGHTER  READY  TO  DEPART  SHIP  TIME. 

CALL  CONVERT <NSHIP<2)  *NSHIP<3>  » NTIMEK3)  » LRDP) 
CALCULATE  LIGHTER  UNDERWAY  TIME  FOR  FORWARD 
NTIME3< 1 ) "LARR-LRDP 


30  CONTINUE 


RETURN 

END 
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SUBROUTINE  CONVERT < NDAY » NSHFT f NHM , MINS ) 

PURPOSE?  CONVERTS  DAYS t SHIFT t HRS  AND  MINS  TO  MINS  FROM  BEGINNING 
OF  THE  TEST 


SEPARATE  NHM  INTO  HOURS  AND  MINS. 

DECODE < 10 f 10 » NDAY)  ND 
10  FORMAT <AX» 14) 

DECODE ( 10 » 10 » NSHFT)  NS 


DECODE  <10*20*  NHM )  NH'NM 
20  FORMAT (6X»I2rI2) 

ADD  24  TO  HRS  LT  18  ON  SHIFT  2 
IF (NS.EQ.2. AND.NH.LT .17)  NH=NH+24 

CALCULATE  DAY  OF  TEST.  DAY1  EQ  0. 
ND*ND-218 

CALCULATE  MINS. 

MINS=ND*24*60  +  NH*60  -I-  NM 


RETURN 


no  o  o  o  o  o  o  no  non 


SUBROUTINE  UPDATE ( KODE  r NSHIP » LSHIP » NSHORE » LSHORE » NTIME1 » LTIME1 
+  NTIME2»LTIME2»NTIME3»LTIME3> 

PURPOSE:  TO  SAVE  CURRENT  RECORD  DEPENDING  ON  VALUE  OF  KODE. 

DIMENSION  K0DE<2) ,NSHIP<7) »LSHIP<7> »NSH0RE<6) »LSH0RE(6) » 

+  NTIMEK4) fLTIME1<4>  »NTIME2(7>  »LTIME2<7) 

+  »NTIME3<3) »LTIME3<3> 

IF  KODE-1  SAVE  SHIP  RECORD 
IF ( KODE (l).NE.l)  GOTO  20 
DO  10  J=l»7 

LSHIP<J)»NSHIP(J) 

10  CONTINUE 

DO  15  J®1>4 

LTIME1 ( J)=NTIME1 < J  > 

15  CONTINUE 

GOTO  50 

20  CONTINUE 

ELSE  SAVE  SHORE  RECORD 
DO  30  J=1 t 6 

LSHORE ( J ) =NSHORE ( J ) 

30  CONTINUE 

DO  40  J«lf 7 

LTIME2  <  J ) »NTIME2  <  J ) 

40  CONTINUE 

DO  45  J-1,3 

LTIME3< J)=NTIME3( J) 

45  CONTINUE 

50  CONTINUE 


RETURN 

END 


non 


SUBROUTINE  RPTINC  < KOBE t NSHIP » NSHORE » NT IME 1 . NT IME2 ) 
PURPOSE:  TO  WRITE  A  NON-MATCHING  RECORD 
LOGICAL  FIRST 

DIMENSION  KQDEC2) »NSHIP<7)  »NSH0RE<6) rNTIMEl (4) . NTIME2(7> 

COMMON/TBLUN I T/NUN I T 1 » NUN I T2 . NUN I T3 » NUN I T4 . NUN I T5 . NUN I T6 

DATA  FIRST/6H.TRUE./ 

IF(. NOT. FIRST)  GOTO  10 
WRITE (NUNIT3. 100) 

100  FORMAT ( 1H1 f 20X. 30HN0NMATCHING  SHIP/SHORE  RECORDS) 

FIRST*. FALSE. 

10  CONTINUE 

IF ( KODE (2).EQ*2)  GOTO  20 

WRITE(NUNIT3f 110)  NSHIP.NTIMEl 
110  FORMAT (5X.6HSH IP  » 10<R4. IX) . IX. 14. IX. 16) 

RETURN 
20  CONTINUE 

WRITE(NUNIT3> 120)  NSHORE. NTIME2 
120  FORMAT (  5X»  6HSH0RE  »  10CR4.1X).  3(I4.1X)r  16) 

RETURN 

END 


B-46 


no  o  o  o  o  o  ooo 


SUBROUTINE  RPTCOM < NSHIP , NSHORE f NTIMEl » NTIME2 » NTIME3 » NSORT ) 


PURPOSE:  TO  WRITE  A  COMBINED  RECORD  BOTH  IN  BINARY  AND  BCD 
LOGICAL  FIRST 

DIMENSION  NSHIP<7) »NSH0RE<4) » NTIMEl (4) »NTIME2(7)  »NTIME3<3) 

COMMON/TBLUNIT/NUNIT1 » NUNI T2 » NUNIT3 r  NUNIT4 » NUNIT5 » NUNIT6 

DATA  FIRST/* TRUE./ 

IF( .NOT. FIRST)  GOTO  10 
WRITE(NUNIT4» 100) 

100  FORMAT < 10X»  32HLIGHTER  SHIP  TO  SHORE  TIMES  FILE  ) 
FIRST-. FALSE. 

10  CONTINUE 


WRITE (NUNIT4r 110)  NSHIP» (NTIMEl < I ) » 1-1 »4) * NSHORE < 1 ) rNTIME2< l)r 
+  NTIME3( 1 ) » 

+  NTIME2<2) »NTIME2<5>  »NTIME2(3) »NTIME2<6) f 

+  NTIME2<4) r 

+  NTIME2<7) rNTIME3(2) »NTIME3<3) 

110  FORMAT <3X»  10<R4»1X)»  1X»  I4»  1X»R4» 1X»4(R4» lXr 14, IX) ,  I4,1X,R4) 


NSHIP » (NTIMEl (I)r 1=1*4) , NSHORE ( 1 ) , NTIME2 ( 1 ) , 
NTIME3< 1 ) , 

NTIME2<2) ,NTIME2<5) »NTIME2<3) ,NTIME2<6) , 
NTIME2<  4) » 

NTIME2 < 7 ) * NTIME3 <  2  > » NTIME3 ( 3 ) , NSORT 
C 

RETURN 

END 


WRITE (NUNIT5) 

+ 

+ 

+ 

+ 


♦  * 
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SUBROUTINE  STOP < NEND » NSTOP t NSTOP1 » KOBE ) 

C 

c  purpose:  to  DETERMINE  IF  EOF  is  in  any  file,  to  determine  if 
C  EOF  IS  IN  ALL  FILES.  SETS  KOBE  TO  WRITE  INCOMPLETE 

C  RECORDS. 

C 

LOGICAL  NSTQP»NSTOPl 
C 

DIMENSION  NEND <  2 ) » KOBE ( 2 ) 

C 

C  TEST  FOR  AT  LEAST  ONE  EOF 

IF (NSTOP)  GOTO  30 
DO  10  J=1 >2 

IF <  NEND ( J ) . EQ . 4R2E0F  >  GOTO  20 
C  NO  EOF  FOUND 

10  CONTINUE 
C 

C  ALL  FILES  CONTAIN  DATA 
NSTOP=. FALSE. 

C 

RETURN 

C 

20  CONTINUE 

C  SET  KOBE  FOR  A  LEAST  ONE  EOF 
NSTOP=>.TRUE. 

C 

30  CONTINUE 

C  CHECK  FOR  EOF  IN  SHIP  FILE. 

K0DE(l)-0 

IF < NEND ( 1 ) » NE « 4RZE0F >  K0DE<1)  =  1 
C 

C  CHECK  FOR  EOF  IN  NSHORE  FILE. 

K0DE<2>*0 

IF(NEND<2) . NE.4RZE0F)  K0DE(2>=2 
C 

C  CHECK  FOR  EOF  IN  ALL  FILES. 

IF(KODE( 1 ) .EQ.O* AND.KODE (2)»EQ»0)  NST0P1=.TRUE. 

C 

C 

RETURN 

END 


onno  ooo  n  ono  ono  onoono 


PROGRAM  WRTRPT <  TAPE1 , OUTPUT  f  TAPE6=0UTPUT ) 


PURPOSE:  TO  READ  THE  SORTED  SHIP  TO  SHORE  TIMES  FILEfCQMPUTE 

STATISTICS  AND  WRITE  REPORT. FOR  EACH  SHIP  FACILITY. DATE 
AND  SHIFT »  STATISTICS  ARE  ACCUMULATED  ON  INDIVIDUAL 
LIGHTERS  AND  LIGHTER  TYPES. 

LOGICAL  FIRSTt KPGBR 

DIMENSION  NSHIP(ll) »NSHORE< 1 1 ) »SUMID<6) .SUMSQID<6) t 
2  SUMTY (6.2) t  SUMSQTY<6.2) . N0IDC3) ,N0TYF<3) .N0TYR<3> 

DATA  BLANK/ 1H  / 

FIRST*  .TRUE. 

INITIALIZE  BREAK  KEYS  AND  STATISTICS 

OFAC*BLANK 
ODATE*BLANK  . 

QSHIFT*BLANK 
20  CONTINUE 

READ  A  SHIP  TO  SHORE  TIMES  RECORD 

READ(l)  NSHIP.NSHORE 
IF(NSHIP<1)  .NE.  4RZE0F)  GO  TO  40 
CALL  PRNIST <  SUMIDfSUMSQIDfNOID ) 

CALL  PRNTST  <  SUMTY  t SUMSQTY  t NOTYF  t NOT YR  > 

STOP 

40  CONTINUE 

KPGBR*  .FALSE. 

CHECK  FOR  PAGE  BREAK  ON  SHIP  FACpDATE  OR  SHIFT 

IF <  <NSHIP< 1 )  .NE.  OF AC)  .OR.  <NSHIP<2)  .NE.  ODATE)  .OR. 

1  <NSHIP<3)  .NE.  OSHIFT)  )  CALL  PGBRK(FIRST ?OFAC»ODATE»OSHIFT ? 

2  NSHIP » NSHORE » KPGBR » OLTRTY r  OLTRID » OFR » 

3  SUMIDrSUMSQIDf SUMTY r SUMSQTY  r 

4  NOID» NOTYF tNOTYR) 

IF (KPGBR)  GO  TO  20 


CHECK  FOR  LIGHTER  TYPErLIGHTER  ID»F  OR  R  BREAK 

IF (  NSHIP<4)  .EQ.  OLTRTY  )  GO  TO  50 
QLTRTY*NSHIP  <  4 ) 

OLTRID*NSHIP ( 5 ) 

OFR*NSHIP ( 8 ) 

C  CALL  PRNIST <  SUMIDfSUMSQIDfNOID) 

CALL  PRNTST <  SUMTY » SUMSQTY » NOTYF »NOTYR) 

CALL  INID(SUMID'SUMSQID'NOID) 

CALL  INTY ( SUMTY » SUMSQTY » NOTYF » NOT YR ) 
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CALL  ACCID<SUMID» SUMSQID *NOID» NSHIP* NSHORE) 

CALL  ACCTY ( SUMTY * SUMSQTY * NOTYF » NOTYR * NSH I P >  NSHORE ) 

CALL  PRNIND ( NSHIP  * NSHORE > 

GO  TO  20 

C  50  IF <  <NSHIP<5)  .EQ.  OLTRID)  .AND*  <NSHIP(8>  .EQ.  OFR ) )  GO  TO  60 
50  IF <NSHIP(8)  .EQ.  OFR)  GO  TO  60 
C  CALL  PRNIST <  SUMID* SUMSQID»NOID) 

0LTRID=NSHIP<5) 

0FR=NSHIP(8) 

CALL  INID<SUMID»SUMSQID»NOID) 

CALL  ACCID< SUMID, SUMSQID »NOID » NSHIP » NSHORE > 

CALL  ACCTY < SUMTY » SUMSQTY r NOTYF * NOTYR , NSHIP * NSHORE ) 

CALL  PRNIND (NSHIP* NSHORE) 

GO  TO  20 
60  CONTINUE 

CALL  PRNIND < NSHIP * NSHORE ) 

CALL  ACCID < SUMIDr SUMSQID » NOID  * NSHIP » NSHORE ) 

CALL  ACCTY ( SUMTY » SUMSQTY » NOTYF * NOTYR  »NSHIP  * NSHORE ) 

GO  TO  20 
END 
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SUBROUTINE  ACCID ( SUMID » SUMSQIB » NOID > NSHIP > NSHOR’E ) 
DIMENSION  SUMID ( 6 ) » SUMSQID <  6 > » NSHIP ( 1 1 ) » NSHORE < 1 1 ) 

ACCUMULATE  INDIVIDUAL  LIGHTER  STATISTICS 

DIMENSION  N0ID<3) 

NOID < 1 >-NOID( 1 )  +  1 

SUMID(l)  =  NSHIP(ll)  +  SUMID(l) 

IF ( NSHORE  ( 3 ) « EG • -999 )  GOTO  10 

N0ID(2)=N0ID(2)  +  1 

SUMID<2>  =  NSH0RE(3)  +  SUMID<2) 

SUMSQID(2>  =NSH0RE<3)  *NSH0RE<3>  +  SUMSQID<2 

10  CONTINUE 

SUMID(3)  =  NSHORE (5 )  -I-  SUMID<3> 

SUMID(4)  =  NSH0RE<7)  +  SUMID(4) 

SUMID<5)  »  NSH0RE<9)  +  SUMID(5) 

IF (NSHORE (10) .EQ.-999)  GOTO  20 

N0ID(3)=N0ID(3)  +  1 

SUMID(A)  =  NSHORE ( 10)+  SUMID(6) 

SUMSQID ( 6 )  =NSH0RE(10)*NSH0RE(10>  +  SUMSQID<6> 

20  CONTINUE 

SUMSQID ( 1 )  =  NSHIP ( 11 )<NSHIP( 11 >  +  SUMSQID(l) 

SUMSQID (3)  -  NSH0RE(5)  *NSH0RE(5)  +  SUMSQID( 

SUMSQID(4)  =  NSH0RE(7)  *NSH0RE<7>  +  SUMSQID( 

SUMSQID(S)  ■  NSH0RE(9)  *NSH0RE(9)  -I-  SUMSQID ( 

RETURN 
ND 


(.1  w 
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SUBROUTINE  ACCTY ( SUMTY , SUHSQTY , NOTYF ,  NOTYR ,  NSHIP  » NSHORE ) 
ACCUMULATE  LIGHTER  TYPE  STATISTICS 

DIMENSION  SUMTY ( 6 , 2 ) * SUMSQTY < 6 , 2 ) , NSHIP ( 11), NSHORE < 1 1 ) , 

2  N0TYR<3>  ,N0TYF(3> 


DATA  BLANK/1H  / 

DATA  NEFF/4R  F/ 

IF <  NSHIP<8>  .EG.  NEFF  >  GO  TO  80 

RETROGRADE  LIGHTER  TYPE  STATISTICS 

NOTYR< 1 >=  NOTYR( 1 )+l 

SUMTY  (1,2)  =  NSHIP ( 11)  +  SUMTY(1,2) 

IF( NSHORE (3) .EQ.-999)  GOTO  10 
NOTYR ( 2 ) “NOTYR ( 2  >  +  1 

SUMSQTY (2, 2)  =NSHORE ( 3 ) *NSHORE ( 3 >  +  SUMSQTY (2, 2) 

SUMTY (2*2)  =  NSHORE (3)  +  SUMTY(2,2) 

10  CONTINUE 

SUMTY (3, 2)  *  NSH0RE(5)  +  SUMTY(3,2> 

SUMTY (4,2)  *  NSHORE (7)  +  SUMTY(4,2) 

SUMTY (5,2)  *  NSHORE (9)  +  SUMTY(5,2) 

IF ( NSHORE < 10) .EQ.-999)  GOTO  20 
N0TYR(3)=N0TYR(3)  +  1 

SUMSQTY  (6,2) =NSH0R£  < 10 ) ONSHORE <1 0  >  +SUMSQTY (6,2) 
SUMTY (6,2)  =  NSHORE ( 10)+  SUMTY(6,2) 

20  CONTINUE 

SUMSQTY (1,2)  =  NSHIP ( 11 )  *NSHIP(li)  +  SUMSQTY(1,2> 

SUMSQTY (3, 2)  «  NSHORE (5)  *NSH0RE(5)  +  SUMSQTY (3, 2) 

SUMSQTY (4, 2)  ■  NSHORE (7)  *NSH0RE(7>  +  SUMSQTY (4, 2) 

SUMSQTY (5, 2)  ■  NSHORE (9)  *NSH0RE(9)  +  SUMSQTY (5, 2) 

RETURN 
80  CONTINUE 

FORWARD  LIGHTER  TYPE  STATISTICS 

NOTYF ( 1 )  =  NOTYF ( 1 )  +  1 

IF ( NSHORE ( 3 ) » EG » -999 )  GOTO  30 

NOTYF ( 2 ) =NOTYF ( 2 )  +  1 

SUMSQTY (2,1)  =NSH0RE(3)*NSH0RE(3>  +  SUMSQTY(2,1) 

SUMTY (1,1)  =  NSHIP(ll)  +  SUMTY (1,1) 

SUMTY (2,1)  =  NSHORE (3)  +  SUMTY(2,1) 

30  CONTINUE 


i 
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SUMTY <  3 » 1  >  -  NSHORE < 5 )  +  SUMTY<3fl> 

SUMTY  <  4 » 1 )  =  NSH0RE<7)  +  SUMTY<4,1> 

SUMTY  <5» 1 )  =  NSHORE ( 9 )  +  SUMTY<5»1> 

IF < NSHORE < 10) »EQ*-999>  GOTO  40 
NOTYF  <  3 ) «NOTYF ( 3 )  +  1 

SUMSQTY  <  6 » 1 )  =NSHORE  < 10 ) ONSHORE ( 10 )  +  SUMSQTY<6»1> 

SUMTY<6» 1 )  =  NSHORE  < 10 ) +  SUMTY<6»1> 

40  CONTINUE 

SUMSQTY <  1 » 1 )  =  NSHIP<  11 )  «NSHIP(U>  +  SUMSQTY<1,1> 

SUMSQTY<3» 1 )  =  NSHORE < 5 )  *NSH0RE<5>  +  SUMSQTY(3fl) 

SUMSQTY <4fl)  •  NSH0RE<7)  *NSH0RE<7>  +  SUMSQTY<4,1> 

SUMSQTY <5» 1 )  =  NSHORE ( 9 >  *NSH0RE<9)  +  SUMSQTY(5,1) 

RETURN 
N 


a 


SUBROUTINE  INTY ( SUMTY , SUMSQTY , NOTYF , NOTYR ) 

DIMENSION  SUMTY ( 6? 2 ) * SUMSQTY <  6 » 2 ) » NOTYF ( 3 ) » NOTYR < 3 ) 
DO  5  1  =  1*3 
NOTYF ( I >=0 
NOTYR ( I  >=0 
5  CONTINUE 
DO  10  1  =  1*6 
DO  20  J=1 » 2 

SUMTY < I* J)=0* 

SUMSQTY  < I  *  J ) =0 ♦ 

20  CONTINUE 
10  CONTINUE 
RETURN 
END 
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SUBROUTINE  PGBRK (FIRST * OFAC f QDATE f OSHIFT » NSHIP f NSHORE * KPGBR f 

1  OLTRTY  fOLTRIDf  OFR f SUMID  f SUMSQID  f SUMTY f  SUMSQTY f  NOID  f  NOTYF f 

2  NOTYR) 

LOGICAL  FIRST »  KPGBR 

DIMENSION  NSHIP ( 11 ) f NSHORE < 11 ) fSUMID( A) fSUMSQID(A) fSUMTY(Af2) f 
1  SUMSQTY <6» 2) fN0ID<3) fN0TYF<3) fN0TYR<3) 

IF (FIRST >  GO  TO  10 

C  PRINT  LIGHTER  ID  AND  TYPE  STATISTICS 

C  CALL  PRNIST (SUMIDfSUMSQIDfNOID) 

CALL  PRNTST ( SUMTY  t SUMSQTY f NOTYF f NOTYR ) 

C  NEU  PAGE  HEADING 

10  CONTINUE 

FIRST  =  .FALSE . 

C  COMPUTE  DAY  OF  AUGUST 

DECODE< 10»20»NSHIP<2) )  ND 
20  FORMAT < AX f 14) 

ND=ND-212 

WRITE<Af 100)  NSHIP ( 1 ) fNDfNSHIP<3) 

100  FORMAT (lHlr  IOXf  27HLIGHTER  SHIP  TO  SHORE  TIMES  /  3X.18HSHIP  FACI 
1LITY  ID:  R4f  3Xf  9HDATE*  AUG  I3f  3Xf  6HSHIFTJ  R4f  /  ) 

WRITE(AfUO) 

110  FORMAT <  21Xf4HFWD  11Xf4HLTR  1Xf4HSH0R  AXf4HLTR  AX 1 4HLPSNAX f 4HLRDY 

1  AX  f 3HLTR7X 1 4HPREV/1 X 1 3HLTR2X 1 3HLTR2X f  2(3HLTR2Xf)f  4H  OR  UXf 

2  4H  AT  lXf 4HFAC  AXf4HUNDR  AXf4H  -  AXf4H  -  6X»4H  AT  IX  f  4HLTR 

3  IXf  4HLTR  /  lXf 4HTYPE  1Xf4H  ID  1Xf4HCYCL  1Xf4HP0S.  1Xf4HRETR  1X» 

4  4HLRDY  1Xf4HLRDP  1Xf4HSHIP1Xf4H  ID  1Xf4HLARR  1Xf4HWAY  1Xf4HLPSN 

5  1Xf4HLARRf 

A  1Xf4HLRDY  1Xf4HLPSN  1Xf4HLRDP  1Xf4HCRAN  1Xf4HSUCC  1Xf4HTYPE  /  ) 
OLTRT Y -NSH I P  <  4 ) 

0LTRID=NSHIP<5) 

0FR-NSHIP<8) 

C 

C  PRINT  INDIVIDUAL  LIGHTER  RECORD 

C 

CALL  PRNIND< NSHIP f NSHORE) 

C  INITIALIZE  LIGHTER  ID  AND  TYPE  STATISTICS 

CALL  INID(SUMIDfSUMSQIDfNOID) 

CALL  INTY < SUMTY f SUMSQTY f NOTYF  f NOTYR ) 

C  ACCUMULATE  LIGHTER  ID  AND  TYPE  STATISTICS 

CALL  ACCID  (SUMIDfSUMSQIDfNOIDfNSHIPfNSHORE) 

CALL  ACCTY < SUMTY f SUMSQTY » NOTYF f  NOT YR  f NSHIP  f NSHORE ) 

OFAC-NSHIP(l) 

0DATE*NSHIP<2> 

0SHIFT«NSHIP<3) 

KPGBR-  .TRUE. 

RETURN 

END 


?  * 
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SUBROUTINE  PRNIST<  SUNID > SUMSQID > NOID ) 

DIMENSION  SUMID ( 6 ) t  SUMSQID ( 6 ) » XBAR ( 6 ) , SD ( 6 ) r NOID ( 3 ) 

COMPUTE  AND  PRINT  INDIVIDUAL  LIGHTER  STATISTICS 

DO  10  I  =  l»6 

N0=N0ID(1) 

IF< I .EQ.2)  N0=N0ID<2) 

IF< I .EQ.6)  NO=NOID ( 3 ) 

IF < NO  .NE.  0)  GO  TO  15 
XBAR( I )=0» 

SD< I )=0» 

GO  TO  10 
15  CONTINUE 

XBAR ( I  >  =  SUMID(  D/NO 

SD<I)=  SUMSQID ( I ) /NO  -  XBAR < I >*XBAR< I ) 

10  CONTINUE 

URITE(6r 100)  NOID? XBARrSD 

100  FORMAT <  lXf HHSTATISTICS:  /  5X*13H  LTR  MEAN  <N=  3I4»2H)J 

1  2X  t  F6*lf  9X»  F6»l  r 

2  A X»  F6» 1 r  5X»F5.1»5Xt 2F5. 1  /  7 Xt  8H  LTR  SD;  19X »F6 . 1 »9X »F6 . 1 , 4X» 

3  F6* 1 f  5Xr  F5* 1 »  5Xf  2F5.1  ) 

RETURN 


SUBROUTINE  PRNTST<  SUMTYf SUMSQTYf NOTYFfNOTYR  ) 

C  COMPUTE  AND  PRINT  LIGHTER  TYPE  STATISTICS 

DIMENSION  SUMTY <6f2) fSUMSQTY<6»2> fXBAR<6f2> fSD<6f2> rN0TYF<3> 

+  fN0TYR<3> 

DO  10  J=1 f  2 
DO  20  1=1 f 6 
IF< J»EQ»2)  GOTO  30 
N=NOTYF ( 1 ) 

IF( I »EQ»2)  N=N0TYF<2> 

IF( I .EQ .6)  N=N0TYF<3> 

GOTO  40 
30  CONTINUE 
N=NOTYR< 1 ) 

IF( I »EQ»2)  N=N0TYR<2> 

IF< I »EQ.6>  N=N0TYR<3> 

40  CONTINUE 

IF<N  .NE*  0)  GO  TO  15 
XBAR<IfJ>=0. 

SD< I f J>=0* 

GO  TO  20 
15  CONTINUE 

XBAR  <  I  f  J ) “SUMTY  < I f  J ) /N 

SD( I  f  J)  =  SUMSQTY < I f  J ) /N  -  XBAR <  I  f  J ) *XB AR <  I  f  J  > 

20  CONTINUE 
10  CONTINUE 
DO  90  1=1 f6 
DO  95  J=1f2 
Z9=SD( I » J) 

SD< I» J)=SQRT  <Z9) 

95  CONTINUE 
90  CONTINUE 

URITE(6f 100) 

100  FORMAT <  3X »  7HF0RWARD  ) 

WRITE<6f 110)  N0TYF»  <  XBAR< I f 1 ) f 1=1 ?6 ) f  <SD< Jf 1 ) f J=1 f6> 

110  FORMAT (  5Xf  13HTYPE  MEAN  <N=  3I4f  2H)J  2Xf  F6.1f  9Xf  F6.1f 

1  4Xf  F6» 1 f  5XfF5» 1 f5Xf2F5* 1  /  7Xf  8HTYPE  SDt  19Xf  F6»1f  9Xf  F6»1f 

2  4XfFA.1f  5Xf  F5*1f  5Xf  2F5»1  > 

URITE(6f120) 

120  FORMAT <  3Xf  10HRETR0GRADE  ) 

WRITE(AfHO)  NOTYRf  <  XBAR(If2) fI=1f6> f  <SD< Jf2> f J=1 f6) 

RETURN 

END 
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APPENDIX  C 


LIGHTER  AND  CARGO 
CYCLE  TIMES 
PROGRAM  LISTINGS 
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L5TAG , CMAOOOO , SPUU  , T500 . ATG 

TASK  <  TN=LQTS , TA=1 2345  * OS=OR I SPMD , TR=TS  t  PI=ATG ) 
COMMENT. *****CTL. STMTS  ON  SHPDATA4***:** 

ATTACH  , S2K ,  S2K260  , ID=SYS2000 » MR=1 . 

REQUEST » LRDY1 ,SN=SYS2. 

REQUEST  , LRDP 1 , SN=S YS2 . 

REQUEST  ,  FI , SN=S YS2 . 

REQUEST, R1,SN=SYS2. 

S2K,CR*77 . 

CATALOG, LRDY1 ,LRDY1 4 , ID=LOTS ♦ 

REWIND, LRDY1. 

COPYBF ,LRDY1 . 

CATALOG, LRDP1,LRDP14,ID=L0TS. 

REWIND, LRDP1 . 

COPYBF, LRDP1. 

CATALOG, FI, F14,ID=L0TS. 

REWIND, FI. 

COPYBF, FI. 

CATALOG , R1 , R14 , ID=LOTS . 

REWIND, Rl. 

COPYBF, Rl. 

*£OR 

USER , LOTS i SHARED  DBN  IS  JLMT4AI 
REPORT  FILE  IS  LRDY1 r 

LI/TITLE  L<4) ,L<4),L<4) ,L(4),L<4),L(4),L(4),L<4)/ 
C1010,C1 110, Cl 120, Cl 530, Cl 510, C 1520, Cl 540, Cl 920 , 
OB  C1010,C1110,C1120,C1530,C1510,C1520 
WH  (C1010  EQ  TCDF  OR  C1010  EQ  COD) 

AND  C1910  EQ  LRDYJ 
REPORT  FILE  IS  LRDPi; 

LI/TITLE  L(4),L<4),L<4),L<4),L<4),L(4) ,L(4>/ 
C1010,C1110,C1120,C1530,C1510,C1520,C1920, 

OB  C1010,C1110,C1120,C1530,C1510,C1520 
WH  (C1010  EQ  TCDF  OR  C1010  EQ  COD) 

AND  C1910  EQ  LRDPJ 
REPORT  FILE  IS  F19 

LI/TITLE  L(4),L(4) ,L<4) ,L<4) ,L<4) ,L(4)/ 
C1010,C1110,C1120,C1530,C1510,C1520, 

OB  C1010,C1110,C1120,C1530,C1510,C1520 
WH  (C1010  EQ  TCDF  OR  C1010  EQ  COD) 

AND  C1820  EXISTS? 

REPORT  FILE  IS  Ri; 

LI/TITLE  L<4) ,L(4) ,L<4) ,L<4) ,L<4) ,L<4)/ 
C1010,C1110,C1120,C1530,C1510,C1520, 

OB  C 1010, Cl 1 1 0, Cl 1 20, C 1530, Cl 5 10, Cl 520 
WH  (C1010  EQ  TCDF  OR  C1010  EQ  COD) 

AND  Cl 720  EXISTS; 

exit; 

tEOR 

♦EOF 


♦  ♦ 


L5TAG , CM60000 , SPUU , T50 . ATG 

TASK  <  TN=LOTS, TA= 12345 ,  OS=ORISPMD » TR~TS » PI=ATG ) 
COMMENT . ##***CTL ♦ STMTS  ON  STEPS  5  S  6***** 

ATTACH  ,  S2K , S2K260 » I D=S YS2000  ,MR=1 . 

REQUEST , UNITS »*PF . 

REQUEST  ,UNIT6,#PF. 

S2K,CR=77. 

CATALOG, UNITS , UNIT45 , ID=LOTS ♦ 

REWIND, UNIT5. 

COPYSBF, UNITS. 

CATALOG , UNIT6 , UNIT46 , ID=LOTS . 

REWIND, UNIT6. 

COPYSBF, UNIT6. 

#EOR 

USER , LOTS ? SHARED  DBN  IS  JLMT4A? 

REPORT  FILE  IS  UNITS? 

LI/TITLE  L(4),L(4),L<4>,L<4>,L<4),L<4>,L(4),L(4),L( 
CIOIO, Cl 110, Cl 120, C1530,C1510,C 1520, C 1540, C 1810, CIS 
OB  C1010,C1110,C1120,C1530,C1510,C1520,C1820 
WH  (C1010  EQ  COD  OR  C1010  EQ  TCDF)  AND  C1820  EXISTS 
REPORT  FILE  IS  UNIT6? 

LI/TITLE  L(4),L<4),L<4),L(4),L(4),L(4),L(4),L<4),L< 
C1010»C1110,C1120,C1530,C15iO,C1520,C1540,C1710,C17 
OB  C1010,C1110,C1120,C1530,C1510,C1520,C1720 
WH  (C1010  EQ  COD  OR  C1010  EQ  TCDF)  AND  C1720  EXISTS? 
EXIT? 

*EOR 

♦EOF 


m  —  r  o 


L5TAG  ,  CM60000 , SPUU , T 1 50 . ATG 

TASK ( TN=LOTS , TA= 12345 ,  OS^QRISPMB  »TR=TS,PI=ATG) 

COHMENT . ***##CTL . STMTS  ON  STEP9***** 

ATTACH  ,  S2K , S2K260  * ID=SYS2000 , MR= 1 . 

REQUEST , UNIT9A , *PF ♦ 

REQUEST, UNIT9B,*PF. 

S2K,CR=77 » 

CATALOG , UNIT9A , UNIT49A , ID=LOTS . 

REWIND, UNIT9A. 

COPYSBF ,UNIT9A ♦ 

CATALOG, UNIT9B,UNIT49B,ID=L0TS. 

REWIND, UNIT9B. 

COPYSBF, UNIT9B. 

*EOR 

USER , LOTS ? SHARED  DBN  IS  JLMT4A? 

REPORT  FILE  IS  UNIT9A? 

LI/TITLE  L(4),L(4),L(4>,L<4>,L(4>,L(4),L(4),L(4),L(4),L(4),L(4) 
L(4) ,L(4)/ 

C1010,C1110,C1120,C1365,C1330,C1335,C1305, 

C1310,C1410,C1420,C1430,C1440,C1450, 

OB  C1010,C1110,C1120,C1330,C1335»C1305,C1310 
WH  (C1010  EQ  TCDF  OR  C1010  EQ  COD)  AND  C1330  NE  NSSC? 

REPORT  FILE  IS  UNIT9B? 

LI/TITLE  L<4),L<4),L<4),L<4),L<4),L(4),L<4),L(4),L(4),L<4),L<4) 
L(4) ,L(4)/ 

Cl 010, Cl 110, Cl 120, Cl 365, Cl 320, Cl 325, Cl 305, 
C1310,C1410,C1420,C1430,C1440,C1450, 

OB  C1010,C1110,C1120,C1320,C1325,C1305,C1310 
WH  <C1010  EQ  TCDF  OR  C1010  EQ  COD)  AND  C1320  NE  NSSC? 

EXIT? 

*EOR 

♦EOF 


«  ♦ 


L5TAG , CM45000 , SPUU  ,  T400 . ATG 

TASK  ( TN=LGTS , TA=1 23 45 , OS=ORISPMD  ,  TR=TS , PI=ATG  ) 
ATTACH , F  , FI 4  , ID=LOTS . 

ATTACH fR»Rl 4 » ID=LOTS. 

REWIND, F . 

REWIND, R* 

FILE<F  , MRL=80,RT=Z,BT=C,FL=80) 
FILE(R,MRL-80,RT=Z, BT=C,FL=80> 
FILE(FR,MRL=80,RT=Z,BT=C,FL=80) 

SORTMRG. 

ATTACH rSHPGEN»SHPGENOBJ» ID=LQTS . 

ATTACH, LRDY 1 , LRDY14, ID=LOTS ♦ 

ATTACH  ,  LRDP1 , LRDP14 , ID=LOTS  * 

SHPGEN( , »FR)  . 

REWIND  » OUTC1 ♦ 

COPYSBF  , OUTC1 ♦ 

REWIND, OUTI1. 

COPYSBF, OUTI1. 

REWIND, OUTBN1. 

FILE (OUTBN1 ,MRL=120) 

FILE<UNIT2) 

SORTMRG. 

ATTACH , PREV , PREVOBJ , ID=LOTS . 

PREV<UNIT2,UNIT3, ) 

REWIND, UNIT3. 

FILE<UNIT3,MRL=130> 

FILE(UNIT4) 

SORTMRG. 

ATTACH, FOR, UNIT45, ID=LOTS. 

ATTACH , RET , UNIT46 , ID=LOTS . 

REWIND, FOR. 

REWIND, RET. 

FI LE  <  FOR , MRL*80 , RT*Z , BT=C , FL=80 ) 

FILE  <  RET , MRL=80 , RT=Z , BT=C , FL=80  > 

FILE  <  UNIT7 , MRL-80 , RT=Z , BT=C , FL=80 ) 

SORTMRG. 

ATTACH , STEP8 , STEP80BJ , ID=LOTS  > 

STEP8. 

REWIND, OUTC7. 

COPYSBF, 0UTC7. 

REWIND, 0UTI7. 

COPYSBF, 0UTI7. 

REWIND, UNIT8. 

FILE(UNIT8,MRL*150) 

FILE<UNITBA> 

SORTMRG. 

ATTACH,FILE1 ,UNIT49A, ID“LOTS. 

ATTACH, FILE2, UNIT49B, ID=LOTS. 

FILE  <  FILE1 , MRL-lOO , RT*Z , BT*C , FL= 1 00 ) 

FI LE  <  F ILE2 , MRL= 100 , RT=Z , BT=C , FL= 1 00 ) 


I 


■ 


,  4 

■-J 


r! 


FILE<UNIT10fMRL=100fRT=ZfBT=CfFL=100> 

SORTMRG ♦ 

ATTACH f  STEP1 1 f  STEP1 1 OBJ f ID=LOTS . 

STEP 11 (UNITIOfOUTIII fOUTCII f  f  f ) 

REWIND r OUTC1 1 . 

COPYSBF  t OUTC1 1 « 

REWINDf OUTI11 ♦ 

COPYSBF  fOUTIII . 

REWINDfUNITII * 

FILE(UNIT11 fMRL=180) 

FILE<UNIT12) 

SORTMRG ♦ 

ATTACH  t STEP13f  STEP130B J  f ID=LOTS . 

STEP13<UNIT12fUNIT13f  f f  > 

REWIND f UNIT 13. 

FILE<UNIT13fMRL=230) 

FILE<UNIT14) 

SORTMRG, 

ATTACH  f STEP1 5 f STEP150BJ t ID=LOTS . 

STEP15, 

REWIND fOUTC15» 

COPYSBF fOUTCIS. 

REWIND  r OUT 1 15 « 

COPYSBF  xOUTIlS* 

REWIND fUNITIS. 

FILE<UNIT15fMRL=320) 

FILE(UNIT16) 

SORTMRG, 

ATTACH » STEP17  f STEP170BJ f ID=LOTS , 

STEP17<UNIT16f  ? ) 

*EOR 

MERGE 

FILE  f MERGE=F f  R  f  OUTPUT=FR 

FIELDf  FACID<  4  f  4  f  DISPLAY ) t DATE  < 1 1 f  4  f  DISPLAY ) f  SHIFT ( 18  f  4  f  DISPLAY ) f 
fLITYP(25f4fDISPLAY) fLITID<32f4fDISPLAY) fLITCY(3?f4fDISPLAY) f 
f  FR ( 46  f  4  f  DISPLAY ) 

KEYfFACID(AfDISPLAY)fDATE(AfDISPLAY) fSHIFT(AfDISPLAY) f 
fLITYP(AfDISPLAY) fLITID<AfDISPLAY)fLITCY<AfDISPLAY) 

END 

*EOR 

SORT 

FILEfS0RT=0UTBN1f0UTPUT=UNIT2 

FIELDfFACID<1f10f DISPLAY) f DATE < 1 1 f IOfDISPLAY ) fSHIFT(21 f IOfDISPLAY) f 
f LITYP < 31 f 10 f DISPLAY ) fLITID< 41 f 10 f DISPLAY) f LITCY< 51 f IOfDISPLAY) f 
fLITPS(61f10fDISPLAY) f DIR <71 f IOfDISPLAY ) fLRDY< 81 f IOfDISPLAY ) f 
fLRDP<?1 f IOfDISPLAY) fLSPT< 101 f IOfDISPLAY) fTIME< 111 f IOfDISPLAY) 

KEY fFACID(Af DISPLAY) f TIME <Af DISPLAY) 

END 

*EOR 

SORT 


i- 
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FILE  , SORT =UNIT3  , OUTPUT =UNIT4 

FIELD,  FACID<  1 .» 10,  DISPLAY )  ,  DATE  <  1 1 » 1 0  s»  DISPLAY  ), SHI FT <21, 10,  DISPLAY  )  , 

, LITTY ( 31 , 10 , DISPLAY ) ,LITID< 41, 10 , DISPLAY ) , LUCY <51 >10, DISPLAY ) , 
,LITPS<61, 10 , DISPLAY ) , DIR <71 , 10 , DISPLAY ) ,LRDY< 81 ? 10 , DISPLAY ) , 

, LRDP < 91 , 10 , DISPLAY ) ,LSPT< 101, 10 , DISPLAY) , SUCC< 111 , 10, DISPLAY) , 
,LITSP<121, 10 , DISPLAY) 

KEY  , FACID  <  A ,  DISPLAY ) ,  DATE ( A, DISPLAY ) , SHIFT ( A ,  DISPLAY ) , 

, LITTY ( A , DISPLAY ) , LI TID<  A, DISPLAY ) »LITCY< A, DISPLAY ) 

END 

#EOR 

MERGE 

FILE  , MERGE=FOR , RET , 0UTPUT=UNIT7 

FIELD, FACID <  4, 4  ,  DISPLAY  >  , DATE< 1 1 » DISPLAY) , SHIFT < 18  r 4 » DISPLAY) , 

, LITTY <25, 4, DISPLAY) ,LITID<32,4, DISPLAY) ,LITCY<39,4, DISPLAY) , 

» LI TPS  <46,4 , DISPLAY) , CARTY (53 ,4, DISPLAY ) » CAR ID <60,4 , DISPLAY ) , 

KEY  , FACID <  A, DISPLAY )  i>DATE<  A  f  DISPLAY )» SHIFT  < A , DISPLAY  )  , 

, LITTY  <  A , DISPLAY ) , LIT ID <  A, DISPLAY ) , LITCY ( A , DISPLAY )  , CARID< A , DISPLAY ) 

END 

*EOR 

SORT 

FILE  , SORT =UNIT8 » OUTPUT =UNIT8A 

FIELD, FACID (  If  10,  DISPLAY)  ,  DATE  <11,  10, DISPLAY  ), SHIFT ( 21 ,  10  j>  DISPLAY  )  , 

, LITTY <31, 10, DISPLAY) ,LITID< 41 , 10 , DISPLAY ) , LITCY (51 , 10 , DISPLAY ) , 

, LITPS <61, 10, DISPLAY), DIR< 71, 10, DISPLAY) , LRDY < 81 , 10 , DISPLAY ) , 

, LRDP <91, 10, DISPLAY) ,LSPT < 101 , 10, DISPLAY ) , SUCC< 1 1 1 , 10 , DISPLAY ) , 

, LITSP< 121, 10, DISPLAY), TYPE( 131, 10, DISPLAY), CARGO( 141, 10, DISPLAY) 
KEY, FACID<A, DISPLAY)  , 

, LITTY (A, DISPLAY ) ,LITID< A, DISPLAY ), CARGO (A, DISPLAY ) , 

, DATE < A, DISPLAY ), SHIFT < A, DISPLAY) 

END 

*EOR 

MERGE 

FILE,MERGE=FILE1,FILE2,0UTPUT=UNIT10 

FIELD, FACID<4, 4, DISPLAY) ,DATE< 11 ,4, DISPLAY ) , SHIFT< 18,4 , DISPLAY ) , 

, 0PR<25, 4, DISPLAY) ,CARTY<32, 4, DISPLAY) , CARID<39, 4, DISPLAY) , 
,CR60ID<46, 4, DISPLAY) ,CRG0ID<53, 4, DISPLAY) , 

, NAME <60, 4,  DISPLAY) , TIME <67, 4, DISPLAY ) , DELAY <74, 4, DISPLAY ) , 

, CAT <81, 4, DISPLAY) ,DUR< 88, 4, DISPLAY) 

KEY, FACID<A, DISPLAY) ,DATE<A, DISPLAY) ,SHIFT(A, DISPLAY) , 

, CARTY < A, DISPLAY ) ,CARID< A, DISPLAY) 

END 

*EOR 

SORT 

FILE , SORT^UNITl 1 ,QUTPUT=UNIT12 

FIELD, FACID< 1,10, DISPLAY), DATE <11, 10, DISPLAY ), SHIFT <21, 10, DISPLAY) , 
,OPER< 31, 10, DISPLAY) , LITTY< 41 , 10, DISPLAY) , LITID< 51 , 10, DISPLAY) , 

, CARID< 61, 10, DISPLAY ) , CYCLE <71, 10, DISPLAY ) ,LDOC< 81, 10, DISPLAY ) , 
,LDLK<91, 10, DISPLAY ) ,LIFT< 101, 10, DISPLAY ) ,CPSN< 11 1,10, DISPLAY ) , 
,LAND< 121, 10, DISPLAY) ,LDUN< 131 , 10 , DISPLAY ), DELY< 141 , 10 , DISPLAY ) , 

, TYPE <151, 10, DISPLAY ) ,SEQ< 161, 10, DISPLAY ) ,TIME< 171, 10, DISPLAY) 


•  ♦ 


KEY  *  FACID  <  A ,  DISPLAY ) , TIME  <  A ,  DISPLAY ) *  SEQ  <  A , DISPLAY ) 

END 

*ECR 

SORT 

FILE  ,  SORT =UNIT1 3 , OUTPUT =UNIT14 

FIELD  fFACID(  If  10,  DISPLAY)  ,DATE<  11  ,10,  DISPLAY  )  , SHIFT <21  rlO»  DISPLAY) 
, OPID( 3 1,10, DISPLAY ) ,LITTY< 41, 10, DISPLAY > ,LITID< 51 f 10 , DISPLAY) f 
fCARG0(61f 10 f DISPLAY ) fCY( 71 f 10 » DISPLAY ) fLDOC< 81 f 10 f DISPLAY ) » 

»DIFF1 (91 flOf DISPLAY ) fLDLK( 101 flOf DISPLAY ) »DIFF2( 11 If 10f DISPLAY ) f 
f LIFT ( 121 f 10 f DISPLAY ) fDIFF3( 131 f 10 f DISPLAY) fCPSN< 141 f 10 f DISPLAY) , 
fDIFF4(151f 10 f DISPLAY ) f LAND (161 f 10 f DISPLAY ) fDIFF5( 171 f 10 f DISPLAY ) f 
fLDUN(181f 10 f DISPLAY ) fDIFF6( 191 f 10 f DISPLAY ) fDELY( 201 f 10 f DISPLAY ) f 
r TYPE (21 If  10 f DISPLAY) ,SEQ (221 f 10 f DISPLAY) 

KEY, FACIIKA, DISPLAY)  f 

f LITTY(Af DISPLAY) fLITIIKAf DISPLAY) f CARGO (Af DISPLAY) f 
f  SEQ ( A  f  DISPLAY ) f  DATE ( A  f  DI SPLAY ) , SHIFT  <  A  f DISPLAY ) 

END 

*EOR 

SORT 

FILE  f  SORT =UNIT15  f  OUTPUT =UNIT16 

FIELD fFACID( If  10 f DISPLAY ) fDATE( Ilf  10 f DISPLAY ) f SHIFT ( 21 f 10 f DISPLAY) 
fLITTY(31f 10 f DISPLAY) fLITID (41 f 10 f DISPLAY ) fLITCY( 51 f 10 f DISPLAY ) f 
fLITPS(61f 10 f DISPLAY ) f DIR <71 f 10 f DISPLAY ) fLRDY( 81 f 10 f DISPLAY ) f 
fLRDP(91f 10f DISPLAY) fLSPT< 101 flOf DISPLAY) fSUCC< 111 flOf DISPLAY) f 
fLITSP(121f 10, DISPLAY )fTYPE( 131 f 10 f DISPLAY) fCARGO( 141 f 10 f DISPLAY )f 
, OPID< 151 , 10, DISPLAY) , LD0C(161 , 10, DISPLAY) , 

,DIFFl(171f 10, DISPLAY ) ,LDLK< 181 ,10, DISPLAY ) ,DIFF2< 191,10 , DISPLAY), 
, LIFT <201, 10, DISPLAY ) ,DIFF3< 21 1,10, DISPLAY ) ,CPSN(221, 10, DISPLAY ) , 
,DIFF4<231, 10, DISPLAY) , LAND < 241 , 10 , DISPLAY ), DIFF5 < 251 , 10 , DISPLAY > , 
,LDUN<261, 10, DISPLAY) , DIFF6 < 271 , 10 , DISPLAY ), DELY < 281 , 10 , DISPLAY > , 

, TYPE1< 291, 10, DISPLAY ) , SEQ <301, 10, DISPLAY ) , TIME <31 1,10, DISPLAY) 
KEY, FACID<A, DISPLAY) ,DATE<A, DISPLAY) ,SHIFT<A, DISPLAY) , 

,LITTY< A, DISPLAY) ,LITID (A, DISPLAY) , 

, DIR < A, DISPLAY ) , TIME < A, DISPLAY ) , SEQ (A, DISPLAY) 

END 


oo  no  n  n  on  nn  no  n  on 


PROGRAM  SHPGEN <  LRDY1 >  LRDP1 » FR 1  *  OUT 1 1 ,  OUTC 1 r OUTPUT , 01JTBN1 > 

+  TAPE1=LRDY1 »  TAPE2=LRDP1 1 T APE3-FR1 > 

+  TAPE4=0UTI 1 »  TAPE5=0UTC1 r TAPE6=0UTPUT • TAPE7-0UTBN1 ) 

C 

LOGICAL  NFIRST >  NFINC » NFCOM  »NSTOP  r NST0P1 >  MATCH 
C 

DIMENSION  KODE <  3 ) » NLRDY ( 6  > » NLRDP ( 6  >  > NFR <  6  >  > NPAM ( 3 ) 

DIMENSION  NEND < 3 >  * NEOF < 1 0 ) 

C 

C0MMQN/TBLUNIT/NUNIT1 ? NUNIT2f NUNIT3»NUNIT4»NUNIT5»NUNIT6f NUNIT7 


INITIALIZE 

NUNIT1=1 

NUNIT2=2 

NUNIT3=3 

NUNIT4=4 

NUNIT5=5 

NUNIT6=6 

NUNIT7=7 


NFIRST=. FALSE. 
NFINC=. FALSE. 
NFCOM=. FALSE. 
NST0P=. FALSE. 
NST0P1=. FALSE. 


10  CONTINUE 

SET  KODE  TO  READ  THREE  FILES. 

K0DE< 1 )=1 
KODE ( 2 ) =2 
K0DE<3)=3 

READ  THREE  RECORDS. 

CALL  READ( KODE » NLRDY  r  NLRDP » NFR  r  NLGTPS » NPAM » NFIRST  *  NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE 

CALL  STOP <  NEND » NSTOP  >  NST0P1 >  KODE ) 

IF (NSTOP)  GO  TO  60 

30  CONTINUE 

COMPARE  LRDY  AND  LRDP  RECORDS. 

CALL  COMPARE < NLRDY i NLRDP r MATCH » NFAIL1 >  NFAIL2 > 


CHECK  FOR  A  MATCH 
IF < MATCH)  GO  TO  40 


THE  MATCH  FAILED.  SELECT  WHICH  FILE  TO  READ. 
CALL  SELECT ( 1  »NFAIL1  »NFAIL2rK'0DE> 


f 
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C  WRITE  THE  RECORD  THAT  DID  HOT  HAVE  A  MATCH. 

CALL  RF'TINC  ( KODE  f NLRDY f NLRDP » NFR  f  NLGTPS ,  NPAM  t NFINC ) 

READ  A  NEW  RECORD. 

CALL  READ  <  KODE  f  NLRDY f NLRDP  f  NFR  f  NLGTPS  f  NPAM  f  NFIRST f  NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE. 

CALL  STOP ( NEND f NSTOP  t NST0P1 *  KODE ) 

IF (NSTOP)  GO  TO  60 

START  THE  LRDYfLRDP  COMPARISON  OVER. 

GO  TO  30 


40  CONTINUE 

A  MATCH  WAS  FOUND  ON  THE  LRDY  AND  LRDP  RECORDS. 

COMPARE  THE  LRDY  AND  THE  F/R  RECORDS. 

CALL  COMPARE < NLRDY » NFR f MATCH » NFA IL 1 f NFAIL2 ) 

CHECK  FOR  A  MATCH. 

IF (MATCH)  GO  TO  50 

THE  MATCH  FAILED.  SELECT  WHICH  FILE  TO  READ. 

CALL  SELECT <  2 f NFAIL1 f NFA IL2  r KODE ) 

WRITE  THE  RECORD  THAT  DID  NOT  HAVE  A  MATCH. 

CALL  RPTINC <  KODE f NLRDY  f  NLRDP f NFR  f  NLGTPS f NPAM  * NFINC) 

READ  A  NEW  RECORD. 

CALL  READ < KODE , NLRDY f NLRDP r NFR f NLGTPS f NPAM f NFIRST f NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE 
CALL  STOP ( NEND  f  NSTOP  f  NSTOP 1 f  KODE ) 

IF (NSTOP)  GO  TO  60 

IF  LRDY  AND  LRDP  RECORDS  WERE  READ  THAN  GO  TO  LRDYf 
LRDP  COMPARE. 

IF (KODE( 1 ) »EQ . 1 .AND. KODE (2) .EG .2)  GO  TO  30 

ELSE  GO  TO  LRDYfFR  COMPARE 
GO  TO  40 

50  CONTINUE 

A  MATCH  WAS  FOUND  ON  THE  LRDYf LRDP f  AND  FR  RECORDS. 

CONVERT  LRDY  TO  MINS  FROM  THE  BEGINNING  OF  THE  TEST’. 

CALL  CONVERT ( NLRDY ( 2 ) fNLRDY(3>  fNPAM( 1 ) fMINS) 

CONVERT  LRDP  TO  MINS  FROM  THE  BEGINNING  OF  THE  TEST. 

CALL  CONVERT  (NLRDY  (2)  f  NLRDY  (3)  fNPAM(2)  fMINSI  ) 

L  c 


L 
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on  non  on  on  n  on  o  on  no  no 


U 


CALCULATE  LIGHTER  AT  SHIP  TIME 
LSHPT=MINS1-MINS 


■  i 

J 


WRITE  A  COMPLETE  RECORD. 

CALL  RPTCOM < NLRDY * NLGTPS » NPAM * NFCOM f LSHPT f MINS ) 


START  OVER  WITH  READING  THREE  NEW  RECORDS. 
GO  TO  10 


60  CONTINUE 

CHECK  FOR  EOF  IN  THREE  FILES. 
IF(NSTOPl)  GO  TO  70 


WRITE  INCOMPLETE  RECORDS. 

CALL  RPTINC ( KODE » NLRDY , NLRDP * NFR » NLGTPS r NPAM » NFINC ) 

READ  A  NEW  RECORD(S) 

CALL  READ ( KODE  >  NLRDY  *  NLRDP » NFR » NLGTPS  r  NPAM » NFIRST , NEND ) 


CHECK  FOR  END  CONDITION. 

CALL  STOP  <  NEND » NSTOP » NSTOP 1 , KODE ) 


CONTINUE  STOP  PROCESS 
GO  TO  60 


70  CONTINUE 


WRITE  EOF  IN  BINARY  FILE 
DO  80  J=l»10 

NEOF ( J ) =4RZE0F 
80  CONTINUE 

WRITE(NUNIT7>  NEOF» LSHPT 'MINS 


END 


no  o  oo  o  on  o  no  n  on  o  o  noon 


SUBROUTINE  READ < KODE ,  NLRDY » NL.RDP , NFR , NLGTPS , NPAM , NFIRST  ,  NEND ) 


purpose:  reads  one  record  from  any  of  three  files  depending 

ON  THE  VALUE  OF  KODE 
LOGICAL  NFIRST 

DIMENSION  KODE  <  3  >  ,  NLRDY  ( 6 )  » NLRDP  <  6 )  ,  NFR  <  6  > » NPAM  ( 3 )  ,  NENDO) 

COMMON/TBLUNIT/NUNIT1 , NUNIT2 , NUNIT3 , NUNIT4 , NUNIT5 , NUNIT6 ,  NUNIT7 

CHECK  TO  DETERMINE  IF  THE  FILES  NEED  REWINDING 
IF(NFIRST)  GO  TO  10 
REWIND  NUNIT1 
REWIND  NUNIT2 
REWIND  NUNIT3 
REWIND  NUNIT4 
REWIND  NUNITS 
REWIND  NUNIT7 
NFIRST=»TRUE. 

10  CONTINUE 

IF  KODE  EQ  1  THAN  READ  THE  LRDY  FILE 
IF < KODE (1)*NE*1)  GO  TO  30 

READ(NUNIT1 ,20)  NLRDY , NLGTPS » NPAM < 1 ) 

20  FORMAT (3Xf8<R4, 3X) ) 

SAVE  EOF  KODE 
NEND ( 1 ) =NLRDY  < 1 ) 

30  CONTINUE 

IF  KODE  EQ  2  THAN  READ  THE  LRDP  FILE 
IF ( KODE <2)»NE*2)  GO  TO  50 

READ(NUNIT2,40)  NLRDP, NPAM<2) 

40  FORMAT ( 3X » 7  <  R4 , 3X ) ) 

SAVE  EOF  KODE 
NEND ( 2 ) =NLRDP ( 1 ) 

50  CONTINUE 

IF  KODE  EQ  3  THEN  READ  THE  R/F  FILE 
IF < KODE <3)*NE»3)  GO  TO  60 

READ<NUNIT3,40>  NFR,NPAM<3) 

SAVE  EOF  KODE 
NEND(3)=NFR(1) 

60  CONTINUE 


♦  ♦ 


RETURN 

END 
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SUBROUTINE  COMPARE < NTEST1 » NTEST2* MATCH »NFAI LI » NFAIL2) 

purpose:  determines  if  two  records  match  on  six  match  keys. 

IF  NO  MATCHf  RETURNS  TO  THE  MAIN  PROGRAM  THE  FIRST 
MATCH  KEYS  WHERE  THE  MATCH  FAILED. 

LOGICAL  MATCH 

DIMENSION  NTEST1 (A) »NTEST2<4> 


NTEST1  HAS  THE  LRDY  RECORD. 

NTEST2  HAS  THE  LRDP  OR  F/R  RECORD. 
COMPARE  ON  THE  SIX  MATCH  KEYS. 

DO  10  J=1 >6 

IF<NTEST1 ( J) .EQ.NTEST2< J) )  GO  TO  10 
THE  MATCH  FAILS. 

MATCH*. FALSE. 

NFAIL1  HAS  THE  LRDY  MATCH  KEY 
NFAIL1=NTEST1 ( J) 

NFAIL2  HAS  THE  LRDP  OR  F/R  MATCH  KEY 
NFAIL2=NTEST2  <  J ) 

RETURN 

10  CONTINUE 


A  MATCH  WAS  FOUND 
MATCH*. TRUE. 


RETURN 

END 


ooooonoo  o  n  onoono  o  onno  nno 


SUBROUTINE  SELECT < KEY , NFAIL1 , NFAIL2 > KOBE ) 


purpose:  determines  which  record  to  read. 

DIMENSION  KODE ( 3 ) 

KEY=1  WHEN  MATCH  FAILED  ON  LRDY r LRDP  RECORDS 
KEY=2  WHEN  MATCH  FAILED  ON  LRDY » NF/R  RECORDS 

GO  TO  <10*20 )  KEY 

10  CONTINUE 

THIS  SECTION  IS  FOR  KEY=1.  A  NON-MATCH  BETWEEN  A  LRDY  RECORD 
AND  A  LRDP  RECORD. 

TEST  TO  DETERMINE  WHICH  FILE  (LRDY f LRDP)  TO  READ. 

IF  MATCH  KEY  LRDY  GT  MATCH  KEY  LRDP  THEN  READ  LRDP  RECORD. 

ELSE  READ  LRDY  RECORD 

KODE ( 1 ) =0 

K0DE<2>=2 

K0DE<3>=0 

IF(NFAIL1 .GT.NFAIL2)  GO  TO  15 
K0DE<1)=1 
K0DE<2>=0 
K0DE<3)=0 
15  CONTINUE 

RETURN 

20  CONTINUE 

THIS  SECTION  IS  FOR  KEY=2.  A  NON-MATCH  BETWEEN  LRDY  AND  NF/R 
FILES. 


TEST  TO  DETERMINE  WHICH  FILE  < LRDY » NF/R  TO  READ. 

IF  MATCH  KEY  LRDY  IS  LT  MATCH  KEY  R/F  THAN  READ  LRDY 
AND  LRDP  RECORDS. 

ELSE  READ  R/F  RECORD 
KODE( 1 )=1 
KODE  <  2 ) =2 
K0DE<3)*0 

IF(NFAIL1 .LT .NFAIL2)  GO  TO  30 
KQDE< 1 )=0 
K0DE<2)=0 
K0DE(3)=3 
30  CONTINUE 
C 

RETURN 

END 


* 
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SUBROUTINE  CONVERT ( NDAY » NSHFT > NHM >  MINS  > 

PURPOSE:  CONVERTS  days* shift >hrs  and  mins  to  mins  from  beginning 
OF  THE  TEST 

DECODE < 10 > 10 » NDAY)  ND 
10  FORMAT  <  6X» 14  > 

DECODE ( 10» 10»NSHFT)  NS 

DECODE ( 10 » 20 » NHM)  NH i NM 
20  FORMAT <4XrI2rI2) 


ADD  2 A  TO  HRS  LT  18  ON  SHIFT  2 
IF<NS.EQ. 2. AND.NH.LT. 18)  NH=NH+24 


CALCULATE  DAY  OF  TEST.  DAY1  EQ  0. 
ND=ND-218 

CALCULATE  MINS. 
MINS=ND*24*60+NH*A0+NM 


RETURN 


SUBROUTINE  RPTINC < KOBE > NLRDY » NLRDP » NFR > NLGTPS , NPAM ?  NFINC ) 
PURPOSE:  WRITES  AN  INCOMPLETE  RECORD 
LOGICAL  NFINC 

DIMENSION  K0DE<3> » NLRDY ( 6 ) » NLRDP ( 6  > » NFR ( 6  >  r NPAM ( 3 ) 

COMMON/TBLUNIT/NUNIT1 »NUNIT2  »NUNIT3  »NUNIT4  »NUNIT5  r NUNIT6 »  NUNIT7 

IF  FIRST  CALL  THAN  PRINT  HEADER 
IF ( NFINC)  GO  TO  20 
XDATE=DATE <  JDUMMY ) 

XTIME=TIME<  JDUMMY) 

WRITE (NUN I T4» 10)  XDATEfXTIME 

10  FORMAT ( lXf 18HINC0MPLETE  REC0RDS»2(5X, A10) r3(5X»R4> ) 

NFINC=.TRUE. 

20  CONTINUE 


DETERMINE  IF  THE  LRDY  RECORD  SHOULD  BE  OUTPUT. 

IF ( KOBE ( 1 ) *NE. 1 )  GO  TO  40 

WRITE < NUNIT4 , 30 )  NLRDY , NLGTPS » NPAM ( 1 ) 

30  FORMAT < 1X»4HLRDY »3Xf 8(R4»3X> » 14) 

40  CONTINUE 

DETERMINE  IF  THE  LRDP  RECORD  SHOULD  BE  OUTPUT. 

IF(K0DE<2) . NE.2)  GO  TO  60 

WRITE (NUNIT4» 50)  NLRDPf NPAM<2) 

50  FORMAT  < lX»4HLRDP»3X»7(R4r 3X) » 14) 

60  CONTINUE 

DETERMINE  IF  THE  F/R  RECORD  SHOULD  BE  OUTPUT, 

IF < KOBE (3) .NE.3)  GO  TO  80 

WRITE (NUNIT4* 70)  NFR>NPAM(3) 

70  FORMAT ( 1X»4H  NFR>3X»7(R4r3X) » 14) 

80  CONTINUE 


RETURN 


SUBROUTINE  RPTCOM <  NLRDY » NLGTPS >  NPAM » NFCOM . LSHPT r  MINS  > 


PURPOSE?  WRITES  A  COMPLETE  RECORD 

LOGICAL  NFCOM 

DIMENSION  NLRb  •'(£)» NPAM  (  3 ) 

COMMON/TBLUNIT/NUNIT1 f NUNIT2»  NUNIT3  »NUNIT4 » NUN ITS  r NUNIT6»NUNIT7 

IF  FIRST  THAN  PRINT  HEADER 
IF (NFCOM)  GO  TO  20 
XDATE=DATE <  JDUMMY > 

XTIME=TIME( JDUMMY) 

WRITE (NUN I T5» 10)  XDATE»XTIME 
10  FORMAT ( 1X» 16HC0MPLETE  REC0RDS»2(5X» A10) r3(5X»R4) ) 

NFCOM® ♦ TRUE. 

20  CONTINUE 


WRITE  A  COMPLETE  RECORD 

WRITE ( NUNIT5 , 30 )  NLRDY , NLGTPS  *  NPAM ( 3  >  * NPAM ( 1 ) , NPAM ( 2  >  r  LSHPT  »MINS 
30  FORMAT (1X»10(R4»3X)»I4»3X»I6) 


WRITE (NUNIT7)  NLRDY > NLGTPS t NPAM ( 3 > »NPAM( 1 ) »NPAM(2) >LSHPT,MINS 


RETURN 


SUBROUTINE  STOP<NEND*NSTOP*NSTOPl  >KODE) 

purpose:  to  DETERMINE  IF  EOF  in  any  file,  to  determine  if 

EOF  IN  ALL  FILES.  SET  KODE  TO  WRITE  INCOMPLETE  RECORDS 

LOGICAL  NSTOP»NSTOPl 

DIMENSION  NEND<3>,  K0DE<3) 

TEST  FOR  AT  LEAST  ONE  EOF. 

IF (NSTOP)  GO  TO  60 
DO  20  J=1 >3 

IF < NEND ( J ) ♦ EG ♦ 4R  EOF)  GO  TO  30 
NO  EOF  FOUND 
20  CONTINUE 

ALL  FILES  CONTAIN  DATA 
NSTOP- . FALSE. 

RETURN 

30  CONTINUE 

SET  KODE  FOR  AT  LEAST  ONE  EOF 
NSTOP= • TRUE . 

60  CONTINUE 

CHECK  FOR  EOF  IN  LRDY  FILE.  SET  KODE. 

K0DE(1)=0 

IF < NEND ( 1 ) « EG ♦ 4R  EOF)  GO  TO  80 
K0DE(1)=1 
80  CONTINUE 

CHECK  FOR  EOF  IN  LRDP  FILE.  SET  KODE. 

K0DE<2)=0 

IF<NEND(2> .EG.4R  EOF)  GO  TO  100 
K0DE(2)=2 
100  CONTINUE 

CHECK  FOR  EOF  IN  THE  F/R  FILE.  SET  KODE. 

K0DE<3)=0 

IF(NEND<3) .EG.4R  EOF)  GO  TO  120 
KQDE<3)=3 
120  CONTINUE 

CHECK  FOR  EOF  IN  ALL  FILES. 

IF(K0DE<1) .EQ.0.AND.K0DE<2) .EQ.0.AND.K0DE(3) .EQ.O)  NST0P1= ♦ TRUE . 


RETURN 


PROGRAM  PREV  <  TAPE1 , OUT » OUTPUT  r TAPE2=0UT  ,  TAPE6=GUTPUT ) 


PURPOSE:  TO  SAVE  PREVIOUS  LRDP  ON  PRESENT  LIGHTER  AT  SHIP  RECORD » 
AND  TO  COMPUTE  LIGHTER  SUCCESSION  TIME  AND  LIGHTER  AT 
SHIP  CYCLE  TIME. 

DIMENSION  N<  14 ) 

REWIND  1 
REWIND  2 
N0LD=4RN0NE 

REPEAT  UNTIL  OUT  OF  DATA 
5  CONTINUE 

READ(l)  (N< I ) » 1=1 f 12) 

IF(N( 1 )  .EQ.  4RZE0F)  GO  TO  10 


N<13)=-999 
N<  14 ) =-999 

CALL  CONVERT <N<2)fN<3) »N<10) »LRDP) 

IF(N< 1 )  .NE.  NOLD)  GO  TO  10 

COMPUTE  LIGHTER  SUCC  TIME  (LRDY-PREV  LRDP) 

N( 13)=N< 12)~NLRDP 

COMPUTE  LIGHTER  AT  SHIP  CYCLE  TIME  (LRDP-PREV  LRDP) 
N ( 14 ) =LRDP-NLRDP 

10  CONTINUE 

WRITE<2)  (N<I)fI=lrll)rN(13)fN<14> 

WRITE<6» 15)  (N<I)fI=lrll)fN(13)fN<14> 

15  FORMAT (10(3X»R4)»3X»I4f3XfI6»2<3XfI4) ) 

NLRDP=LRDP 

N0LD=N(1) 

IF(N( 1 )  .EG.  4RZE0F)  GO  TO  30 

GO  TO  5 
30  CONTINUE 


SUBROUTINE  CONVERT < NDAY » NSHFT » NHH t HINS ) 

PURPOSE:  CONVERTS  DAYS»SHIFT>HRS  AND  HINS  TO  HINS  FROH  BEGINNING 
OF  THE  TEST 

DECODE ( 10 r 10 f NDAY)  ND 
10  FORHAT ( 6X » 14  > 

DECODE < 10 » 10 » NSHFT)  NS 

DECODE <10, 20, NHH)  NH,NM 
20  FORHAT <6X,I2,I2) 


ADD  24  TO  HRS  LT  17  ON  SHIFT  2 
IF ( NS. EG. 2* AND.NH.LT. 17)  NH=NH+24 


CALCULATE  DAY  OF  TEST.  DAY1  EQ  0. 
ND=ND-218 

CALCULATE  HINS. 

HINS=ND*24*60  +  NH*60  +  NM 


RETURN 


no  on  on  on  on  no  o  o  on  n  no  o  o  non 


PROGRAM  STEP8 < UNIT4 * UNIT7 »QUTI7*0UTC7r UNIT8, OUTPUT , 

+  T APE1=UNIT4  t T APE2=UNIT7  >  T APE3=0UTI7 1 

+  TAPE4=QUTC7 , TAPE5=UNIT8 > TAPE6=0UTPUT ) 

purpose:  adds  cargo  type  and  cargo  id  to  lighter  records 

LOGICAL  NPR INT * NSTOP  > NSTOP 1 * MATCH 

DIMENSION  K0DE<2) * LIGHTER ( 13) *NCARG0(9> *NEND(2> 

C0MM0N/TBLUNIT/NUNIT1 , NUNIT2 * NUNIT3 *  NUNIT4 * NUNIT5 . NUNITA 

INITIALIZE 

NUNIT1=1 

NUNIT2=2 

NUNIT3=3 

NUNIT4=4 

NUNIT5=5 

NUNIT6=A 

NPRINT=. FALSE. 

NSTOP**  .FALSE. 

NSTOP 1=. FALSE. 

MATCH=  .FALSE. 

SET  KODE  TO  READ  BOTH  FILES 
NODE  < 1 )  =  1 
KODE ( 2 ) =2 

10  CONTINUE 

READ  LIGHTER  AND/OR  CARGO  RECORDS. 

CALL  READ < KODE » LIGHTER  » NCARGO * NEND > 

CHECK  FOR  EOF  IN  ANY  FILE. 

CALL  STOP ( NEND * NSTOP * NST0P1 »  KODE ) 

IF (NSTOP)  GOTO  30 

COMPARE  LIGHTER  AND  CARGO  RECORDS. 

CALL  COMPARE (LIGHTER * NCARGO r MATCH r NFAIL1 * NFAIL2 > 

CHECK  FOR  A  MATCH 
IF(MATCH)  GO  TO  20 


THE  MATCH  FAILED.  SELECT  WHICH  FILE  TO  READ. 
CALL  SELECT (NFAIL1 *NFAIL2*K0DE ) 


WRITE  AN  INCOMPLETE  RECORD*  IF  ANY 
CALL  RPTINC ( KODE  *  LIGHTER » NCARGO  *  NPRINT ) 

START  OVER  AND  READ  A  NEW  RECORD 
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GO  TO  10 


I 


on  on  on  nonooonoo 


SUBROUTINE  READ ( KODE > L I GHTER , NCARGO » NEND ) 

purpose:  to  read  a  record  from  the  lighter  times  file  and/or 

THE  CARGO  ID  FILE 


LOGICAL  FIRST 


DIMENSION  KODE < 2) »LIGHTER< 13) »NCARG0<9) » NEND (2) 
CQMMQN/TBLUNIT/NUNIT1 » NUNIT2 1 NUNIT3 » NUNIT4 » NUN ITS  t NUNIT6 
DATA  FIRST/6H.TRUE./ 


REWIND  FILES  FIRST  TIME  THRU 
IF< .NOT. FIRST)  GO  TO  10 
REWIND  NUN IT 1 
REWIND  NUNIT2 
REWIND  NUNIT3 
REWIND  NUNIT4 
REWIND  NUNIT5 
FIRST=. FALSE. 

10  CONTINUE 

IF  KODE ( 1 ) =1  READ  LIGHTER  FILE 
IF(  K0DE<1)  .NE.  1  )  GO  TO  20 
READ(NUNITl)  LIGHTER 
NEND  < 1 ) =LIGHTER  < 1 ) 

20  CONTINUE 

IF  K0DE<2)=2  READ  CARGO  FILE 
IF <  KODE ( 2 )  .NE.  2  )  GO  TO  40 
READ(NUNIT2»30>  NCARGO 
30  FORMAT  <9<3X»R4) ) 

NEND ( 2 ) =NC ARGO ( 1 ) 

40  CONTINUE 


RETURN 

END 
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SUBROUTINE  COMPARE ( NTEST1 » NTEST2 » MATCH » NFAIL1 > NFAIL2 ) 

purpose:  determines  if  two  records  match  on  six  match  keys. 

IF  NO  MATCHf  RETURNS  TO  THE  MAIN  PROGRAM  THE  FIRST 
KEY  WHERE  THE  MATCH  FAILED. 

LOGICAL  MATCH 

DIMENSION  NTEST1 (13) »NTEST2<9) 


COMPARE  ON  THE  SIX  MATCH  KEYS. 

DO  10  J=1 » 6 

IF<  NTESTl(J)  .EQ.  NTEST2(J>  )  GOTO  10 

THE  MATCH  FAILS 
MATCH=. FALSE. 

NFAIL1=NTEST1 <  J  > 

NFAIL2=NTEST2< J> 

RETURN 

10  CONTINUE 

A  MATCH  WAS  FOUND 
MATCH=.TRUE. 


RETURN 


non  noon 


SUBROUTINE  SELECT ( NFAIL1 » NFAIL2 > KOBE ) 

PURPOSE?  DETERMINES  WHICH  FILE  TO  READ. 

DIMENSION  K0DE<2) 

KODE< 1 ) =1 
K0DE(2>=0 

I F(  NFAIL1  .LT.  NFAIL2  >  GOTO  10 
KODE< 1 )“0 
KOBE ( 2 ) =2 

10  CONTINUE 


RETURN 

END 
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SUBROUTINE  RPTINC < KOBE > LIGHTER »NCARGO> NPRINT) 

PURPOSE:  WRITES  AN  INCOMPLETE  RECORD 
LOGICAL  FIRST t NPRINT 

DIMENSION  K0DE<2) » LIGHTER < 13) »NCARG0<9) 

CQMM0N/TBLUNIT/NUNIT1 »NUNIT2»NUNIT3»NUNIT4»NUNIT5»NUNIT6 

DATA  FIRST/6H.TRUE./ 

PRINT  HEADER  ON  FIRST  CALL 
IF < .NOT .FIRST)  GO  TO  20 
XDATE=DATE< JDUMMY) 

XTIME=TIME< JDUMMY) 

WRITE<NUNIT3» 10)  XDATErXTIME 
10  FORMAT ( 1H1 t 18HINC0MPLETE  REC0RDSr2<5X>A10) ) 

FIRST=. FALSE. 

20  CONTINUE 

DETERMINE  WHICH  RECORD  TO  OUTPUT 
IF ( KOBE < 1 )  .NE.  1)  GOTO  50 
IF< .NOT. NPRINT)  GOTO  30 
NPRINT=. FALSE. 

RETURN 

30  CONTINUE 

NPRINT=. FALSE. 

WRITE(NUNIT3»40)  LIGHTER 
40  FORMAT ( 1X»7HLIGHTER» 10<  3X  »R4) f3(3XfI4>  > 

RETURN 


50  CONTINUE  -1 

WRITE<NUNIT3,60)  NCARGO  £» 

60  FORMAT < 1X»5HCARG0?9<3X»R4) )  1 


RETURN 

END 


i 
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SUBROUTINE  RPTCOM < LIGHTER » NCARGO » NPRINT ) 

PURPOSE:  WRITES  A  COMPLETE  RECORD 

LOGICAL  FIRST t NPRINT 

DIMENSION  LIGHTER < 13) »NCARG0(9) 

COMMON/TBLUNIT/NUNIT1 »NUNIT2»NUNIT3*NUNIT4  »NUNIT5»NUNIT6 

DATA  FIRST/6H.TRUE./ 

WRITE  HEATER  ON  FIRST  CALL 
IF( .NOT. FIRST)  GOTO  20 
XDATE=DATE  <  JDUMMY > 

XTIME=TIME ( JDUMMY ) 

WRITE<NUNIT4» 10)  XDATE»XTIME 
10  FORMAT < 1H1 r 16HC0MPLETE  REC0RDS»2(5X>A10) ) 

FIRST=. FALSE. 


20  CONTINUE 

WRITE  A  COMPLETE  RECORD 

WRITE <NUNIT4, 30)  LIGHTER » NCARGO ( 8 ) » NCARGO < 9 ) 

30  FORMAT <1X»10<3X»R4) , 3 < 3X» 14 ) » 2 < 3X » R4 > ) 

WRITE<NUNIT5)  LIGHTER >NCARGO( 8)  i>NCARGQ<9) 

SET  CODE  TO  TRUE.  THE  PRESENT  LIGHTER  RECORD  WAS  COMPLETE 
NPRINT=, TRUE. 


RETURN 


on  non  on  non  on  n  no  o  no  n  noon 


SUBROUTINE  STOP ( NEND » NSTOP » NST0P1 , KOBE ) 


purpose:  to  DETERMINE  IF  EOF  in  any  file,  to  determine  if 

EOF  IN  ALL  FILES.  SETS  KOBE  TO  INDICATE  RECORDS. 

LOGICAL  NSTOP t NST0P1 

DIMENSION  NEND(2) »K0DE<2) 

TEST  FOR  AT  LEAST  ONE  EOF 
IF (NSTOP)  GOTO  30 
DO  10  J=1 » 2 

IF <N£ND< J)  .EQ.  4RZE0F)  GOTO  20 
NO  EOF  FOUND 
10  CONTINUE 

ALL  FILES  CONTAIN  DATA 
NSTOP=. FALSE. 

RETURN 


20  CONTINUE 

SET  KOBE  FOR  AT  LEAST  ONE  EOF 
NSTOP= . TRUE . 

30  CONTINUE 

CHECK  FOR  EOF  IN  LIGHTER  FILE 
K0DE<1)=0 

IF ( NEND < 1 ) . NE . 4RZE0F )  K0DE<1>=1 

CHECK  FOR  EOF  IN  CARGO  FILE 
KODE(2)=0 

IF(NEND<2)  .NE.4RZE0F)  K0DE(2)=>2 


CHECK  FOR  EOF  IN  ALL  FILES. 

IF ( KODE ( 1 ) . EQ . 0 . AND . KODE ( 2 ) » EG . 0 )  NST0P1  =  .TRUE. 


RETURN 

END 

L'  ,  ♦ 


k 
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PROGRAM  CARGO  I  Cl  ( CARGO  *  OUT  1 1 * OUTC1  »  UNIT1 1 *  OUTPUT  * 

+  TAPE1=CARG0*TAPE2=0UTI1 >TAPE3=0UTC1 * 

+  TAPE4=UNIT1 1 *  TAPE6=0UTPUT ) 

C 

LOGICAL  STOP *  FIRST  * END* FLAG *FIRST1 
C 

DIMENSION  NDATA( 13) *NPAM(6) *NDELAY1 (20) *NDELAY2(20) * 

+  NSAOE(S) 

C 

C0MM0N/TBLUNIT/NUNIT1 »NUNIT2  >NUNIT3*NUNIT4 
C 

C  INITIALIZE 

NUNIT1=1 
NUNIT2=2 
NUNIT3=3 
NUNIT4=4 
STOP®. FALSE. 

C 

10  CONTINUE 

C  SET  FLAG  TO  INITIALIZE  SUBROUTINE  CHANGE 

FIRST®. TRUE* 

C  SET  FLAG  TO  INITIALIZE  SUBROUTINE  BUILD 

FIRST1® .TRUE. 

C 

C 

20  CONTINUE 

C  READ  A  CARGO  RECORD 

CALL  READ (NDATA* STOP) 

IF < STOP)  GO  TO  30 
C 

C  CHECK  FOR  A  CHANGE  ON  FACILITY  ID*  LIGHTER  TYPE*  LIGHTER  ID* 

C  CARGO  ID  OR  CARGO  CYCLE  CHANGE. 

CALL  CHANGE<NDATA*FIRST*END> 

C 

C 

C  TEST  FOR  CHANGE 

IF (END)  GO  TO  30 
C 

C  NO  CHANGE.  CONTINUE  TO  BUILD  A  NPAM  RECORD. 

CALL  BUILD < NDATA »FIRST1 »NPAM*NDELAY1 *NDELAY2* 

+  NSEQ » FLAG » NSAVE  > 

C 

GO  TO  20 
C 
C 
C 

30  CONTINUE 

C  TEST  FOR  COMPLETE  OR  INCOMPLETE  RECORD. 

IF (FLAG)  GO  TO  40 

C  WRITE  AN  INCOMPLETE  RECORD. 
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CALL  RPT INC <  NSAVE * NPAM > NSEQ » NDEL A Y 1 , NDELAY2 ) 
GO  TO  50 


40  CONTINUE 

COMPUTE  TIME  FROM  0  BASED  ON  LDUN 

CALL  CONVERT < NSAVE ( 2 ) »NSAVE(3>  »NPAM<6) » NT I ME) 

WRITE  A  COMPLETE  RECORD. 

CALL  RPTCOM ( NSAVE  *  NPAM » NSEQ , NDELAY1 » NDELAY2 » NTIME ) 


50  CONTINUE 

CHECK  FOR  EOF 
IF (STOP)  GO  TO  60 
BACKSPACE  1 
GO  TO  TOP  OF  PROGRAM 
GO  TO  10 


•  « 


60  CONTINUE 
END 


no  on  on  on  on  o  o  non 


SUBROUTINE  READ ( NDATA  *  STOP ) 

PURPOSE:  TO  READ  ONE  INPUT  RECORD. 

LOGICAL  FIRST » STOP 
DIMENSION  NDATA < 13 ) 

COMMON/TBLUN IT/NUN I T1 »NUNIT2  »NUNIT3  >NUNIT4 

DATA  FIRST/6H.TRUE./ 

REWIND  FILES  THE  FIRST  TIME  THRU 
IF< .NOT .FIRST)  GO  TO  10 
REWIND  NUNIT1 
REWIND  NUNIT2 
REWIND  NUNIT3 
REWIND  NUNIT4 
FIRST=. FALSE. 

10  CONTINUE 

READ  ONE  RECORD 
READ  <  NUNIT1 1 20 )  NDATA 
20  FORMAT < 13 < 3X » R4 > ) 

CHECK  FOR  EOF 
IF<E0F<NUNIT1 ) )  30,40 
30  CONTINUE 

STOP55 .  TRUE . 


40  CONTINUE 


RETURN 

END 


fc 
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SUBROUTINE  CHANGE ( NDATA » FIRST » END ) 

purpose:  to  set  the  value  of  end  to  TRUE  WHEN  FACILITY  ID f 

LIGHTER  TYPE t  LIGHTER  ID,  CARGO  ID  OR  CARGO  CYCLE  CHANGE 

LOGICAL  END , FIRST 

DIMENSION  NDATA( 13) 

IF( .NOT, FIRST)  GO  TO  10 
NFACID=NDATA< 1 ) 

NLITTY=NDATA(5) 

NLITID=NDATA(6) 

NCARID=NDATA<7) 

NCARCY=NDATA<8> 

FIRST3*.  FALSE. 

END=, FALSE. 

RETURN 
10  CONTINUE 


SET  END  TO  TRUE  IF  ANY  KEY  CHANGES 


IF  <NDATA< 1 )  . NE , 
IF  <NDATA<5)  .NE. 
IF  <NDATA<6)  .NE. 
IF<NDATA<7)  .NE. 
IF (NDATA(8)  .NE. 
SAVE  PRESENT  KEY 
NFACID=NDATA(1) 
NLITTY=NDATA(5) 
NLITID=NDATA<6) 
NCARID=NDATA<7) 
NCARCY=NDATA<8> 


NFACID)  END=.TRUE 
NLITTY )  END=.TRUE 
NLITID)  END=.TRUE 
NCARID)  END=»TRUE 
NCARCY)  END=.TRUE 
VALUES, 


RETURN 


SUBROUTINE  BUILD  <  NDATA . FIRST  r  NPAM  ,  NDEL AY 1 »  NDELAY2 » 

+  NSEQ  t FLAG  r NS  AVE ) 

purpose:  to  construct  a  NPAM  RECORD  WHICH  CONTAINS  LDOC.  LDLK r 

LIFT » CPSN t LAND r LDUN  AND  TO  CONSTRUCT  A  NDELAY  RECORD(S) 
WHICH  CONTAINS  DELAY  TYPE r  DELAY  CATEGORY  AND  DELAY 
DURATION.  SETS  A  FLAG  TO  INDICATE  IF  THE  RECORD  IS 
COMPLETE. 

LOGICAL  FIRST ? FLAG 

DIMENSION  NDATA < 13) >NPAM<6) »NAME<6) » NDEL AY 1 (20) »NDELAY2(20) r 
+  NSAVE ( 8  > 

DATA  NAME/4RLD0C r  4RLDLK ,  4RLIFT >  4RCPSN >  4RLAND >  4RLDUN/ 

IF< .NOT. FIRST)  GO  TO  20 
DO  10  J=1 »  6 

NPAM  <  J ) *4RN0NE 
10  CONTINUE 
NSEQ=0 

NDELAY 1(1) =4RN0NE 
NDELAY2 ( 1 ) =4RN0NE 
FIRST=.FALSE. 

SAVE  FIRST  EIGHT  VALUES  OF  PRESENT  NDATA 
DO  15  J=1 » 8 

NSAVE  <  J ) =NDAT  A  <  J ) 

15  CONTINUE 
20  CONTINUE 


SET  THE  EVENT  TIME  IN  THE  CORRESPONDING  EVENT  NAME  PARAMETER 
DO  30  J=1 r6 

IF <NDATA<9)  .EQ.  NAME<J)>  NPAM< J)=NDATA< 10) 

30  CONTINUE 


CHECK  FOR  A  COMPLETE  NPAM  RECORD 
FLAG* .TRUE. 

DO  40  J=1 *6 

IF <NPAM< J)  .EQ.  4RN0NE)  FLAG*. FALSE. 

40  CONTINUE 

CHECK  TO  DETERMINE  IF  DELAY  PARAMETERS  EXIST  IN  NDATA  RECORD. 
IF <NDATA< 11 )  .EQ.  4RU  )  RETURN 

A  DELAY  EXISTS 
NSEQ=NSEQ+1 

NDELAY1 <  NSEQ ) *NDATA < 1 0 ) 

NDELAY2  <  NSEQ ) =NDATA < 1 1 ) 


RETURN 


nn  no  nnn  non  n  n  non 


SUBROUTINE  CONVERT < NDAY * NSHFT , NHM , MI NS ) 


C 

PURPOSE:  CONVERTS  DAYS r SHIFT fHRS  AND  MINS  TO  MINS  FROM  BEGINNING 
OF  THE  TEST 

DECODE< 10* 10»NDAY)  ND 
10  FORMAT ( 6X » 14 ) 

DECODE ( 10 f 1 On NSHFT)  NS 

DECODE < 10 » 20 » NHM)  NH>NM 
20  FORMAT (6X»I2»I2) 


ADD  24  TO  HRS  LT  17  ON  SHIFT  2 
IF  <  NS . EQ . 2 ♦ AND . NH . LT . 1 7 )  NH=NH+24 


CALCULATE  DAY  OF  TEST.  DAY1  EQ  0. 
ND=ND-218 

CALCULATE  MINS. 

MINS=ND*24*60  +  NH*60  +  NM 


RETURN 

END 
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SUBROUTINE  RPTINC  <  NDAT A  r NPAM  *  NSEQ  >  NDELAY 1 r NDELAY2 ) 
PURPOSE:  WRITES  AN  INCOMPLETE  RECORD. 

LOGICAL  FIRST 

DIMENSION  NDATA<8) >NPAM<6) t NDELAY1 ( 20 ) > NDELAY2 ( 20 ) 

COMMON/TBLUNIT/  NUNIT1 »NUNIT2»NUNIT3,NUNIT4 

DATA  FIRST/6H ♦ TRUE ./ 

WRITE  HEADER  ON  FIRST  CALL 
IF( .NOT. FIRST)  GO  TO  20 
XDATE=DATE<  JDUMMY > 

XTIME=TIME< JDUMMY) 

WRITE < NUNIT2* 10 )  XDATE » XTIME 
10  FORMAT <  1H1 » 24H INCOMPLETE  CARGO  RECORDS , 2 < 5X , A10 ) ) 

WRITE<NUNIT2» 15) 

IS  FORMAT ( 59X » 4HLD0C » 3X * 4HLDLK , 3X » 4HLIFT » 3X > 4HCPSN r  3X » 

+  4HLAND » 3X » 4HLDUN ) 

FIRST=.FALSE. 

20  CONTINUE 


WRITE  INCOMPLETE  CARGO  RECORD 
DO  40  J=1 »  NSEQ 

WRITE ( NUNIT2  r 30 )  < NDATA < I ) , 1  =  1 , 8 ) r NPAM  t NDELAY 1  ( J )  r  NDEL A Y2 ( J ) 
30  FORMAT  < 1 A  <  3X  t R4 ) ) 

40  CONTINUE 


RETURN 

END 
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SUBROUTINE  RPTCOM  <  NDATA »  NF‘AM  ,  NSEQ  r  NDELAY1 ,  NDELAY2  t  NT  IME  ) 
PURPOSE:  WRITES  A  COMPLETE  RECORD. 

LOGICAL  FIRST 

D I MENS ION  NDATA <  8  >  r  NPAM (6), NDEL A Y 1 (20), NDELAY2 < 20 ) 

CQMM0N/TBLUNIT/NUNIT1 , NUNIT2 , NUNIT3*  NUNIT4 
DATA  FIRST/6H.TRUE./ 

WRITE  HEADER  ON  FIRST  CALL 
IF ( .NOT .FIRST)  GO  TO  20 
XDATE=DATE ( JDUMMY ) 

XTIME=TIME<  JDUMMY ) 

WRITE (NUN I T3f 10)  XDATE » XTIME 
10  FORMAT < 1H1 »22HCQMPLETE  CARGO  REC0RDS»2(5X»A10) ) 

FIRST=. FALSE. 

20  CONTINUE 


WRITE  A  COMPLETE  CARGO  RECORD 
DO  40  J=1»NSEQ 

WRITE <NUNIT3» 30)  ( NDATA < I ) » 1  =  1 f 8 >  » NPAM , NDELAY1 ( J ) r 
+  NDELAY2< J> f JrNTIME 

30  FORMAT <16<2X*R4)»2X»I4»2X»I&) 

WRITE ( NUNIT4 )  <NDATA< I ) > 1=1  * 8) f NPAM»NDELAY1 ( J) , 

+  NDELAY2< J) f J»NTIME 

40  CONTINUE 


RETURN 
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PROGRAM  STEP 1 3  <  TAPE 1  *  TAPE2 , TAPE3 » OUTPUT  >  TAPE4=0UTPUT ) 

purpose:  to  write  previous  ldun  on  present  record  and  to 

COMPUTE  THE  PARTS  OF  THE  CRANE  CYCLE . 

DIMENSION  N  d  8 )  > NPREV (3)»J<6> 

REWIND  1 
REWIND  2 
REWIND  3 

REPEAT  UNTIL  OUT  OF  DATA 
10  CONTINUE 
READ(l)  N 

IF<  EOF < 1 ) )  30 1 20 
20  CONTINUE 

OBTAIN  PREVIOUS  DATE»SHIFT  AND  LDUN. 

CALL  SAVE(Nd) *N<2>  »N<3>  rN( 14) > NPREV) 

COMPUTE  CPMPONT  PARTS  OF  A  CRANE  CYCLE. 

CALL  COMPUTE  <  N » NPREV » J ) 

WRITE  RESULTS 

WRITE  <  2 )  <<N<I)rI=lf?>,J<l>rN<10>rJ<2>rN<ll>rJ<3>rN(12>r 
+  J(4)rN(13)rJ(5)rN(14)rJ(6>r <N< I ) » I=15» 17) ) 

WRITE <3»25>  ( <N<I) f I  =  lf?) r J(l)rNdO) f J(2>  fN(ll) » J(3) fN(12) f 
+  J(4)»N(13)»J<5)»Nd4)»J(A)f  (N(  I  >  r  1  =  15  r  17) ) 

25  FORMAT  <lX»9<R4»lX)»A<I4flXfR4»lX) rR4r lXrI4> 


GO  TO  10 


30  CONTINUE 


END 
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SUBROUTINE  COMPUTE ( NDATA . NPREV *  NTIME  > 


purpose:  to  compute  compont  parts  of  a  crane  cycle. 

DIMENSION  NDATA ( 17) »NPREV<3>  *NTIME(6> 

CONVERT  ELASPED  CYCLE  TIME  TO  MINS  FROM  THE  BDGINNING 
OF  THE  TEST. 

CALL  CONVERT ( NDATA  <  2  > » NDATA  <  3  > , NDATA  <  9 )  » NLDOC  > 

CALL  CONVERT  <  NDATA ( 2 ) » NDATA ( 3 ) » NDATA  < 10 ) , NLDLK ) 

CALL  CONVERT (NDATA< 2) f NDATA ( 3 ) rNDATA< 11 ) rNLIFT) 

CALL  CONVERT (NDATA<2) »NDATA<3> »NDATA( 12) .NCPSN) 

CALL  CONVERT  <  NDATA  <  2 ) » NDATA  <  3 ) » NDATA ( 1 3 ) , NL AND ) 

CALL  CONVERT  <  NDATA  <  2 ) , NDATA ( 3  > , NDATA  < 1 4 ) , NLDUN ) 


COMPURE  COMPONT  PARTS  OF  THE  CRANE  CYCLE 

NTIME ( 2 ) =NLDLK-NLDQC 

NTIME  <  3 ) =NLIFT-NLDLK 

NTIME  <  4 ) =NCPSN-NLIFT 

NT I ME ( 5 ) =NLAND-NCPSN 

NT IME ( 6 ) =NLDUN-NLAND 


IF  PREVIOUS  LDUN  EXISTS  THEN  COMPUTE  PART  OF 
CYCLE  BASED  ON  PREVIOUS  LDUN. 

NTIME<l)=-999 

IF ( NPREV ( 3 )  .EQ.  4RN0NE)  GO  TO  10 

CALL  CONVERT ( NPREV  < 1 ) » NPREV (2  >  » NPREV ( 3  >  r NLDUNP ) 
NTIME  < 1 ) =NLDOC-NLDUNP 
10  CONTINUE 


RETURN 


SUBROUTINE  SAVE  <  NFACID » NDATE , NSHIFT > NLDUN >  NPREV ) 

PURPOSE:  TO  RETURN  PREVIOUS  LDUN.  IF  FIRST  EVENT  AT  A  FACILITY 
THERE  IS  NO  PREVIOUS  LDUN . 

LOGICAL  FIRST 

DIMENSION  NPREV < 3 > 

DATA  FIRST  /6H.TRUE./ 

IF (  .NOT .FIRST)  GO  TO  10 
IFACID=4RN0NE 
FIRST=. FALSE. 

10  CONTINUE 


NPREV  <  3 ) =4RN0NE 

CHECK  FOR  CHANGE  IN  FACILITY  ID 
IF ( NFACID  »NE.  IFACID)  GO  TO  20 
NPREV( 1 )=IDATE 
NPREV<2)=ISHIFT 
NPREV<3)=ILDUN 
20  CONTINUE 


SAVE  PRESENT  LDUN  AND  FACID 

IDATE=NDATE 

ISHIFT=NSHIFT 

ILDUN=NLDUN 

IFACID=NFACID 


RETURN 


n  n  no  non  non  n  n  noon 


SUBROUTINE  CONVERT < NDAY , NSHFT t NHh , MINS  > 


purpose:  CONVERTS  DAYS  r SHIFT » HRS  and  mins  to  mins  from  beginning 
OF  THE  TEST 

DECODE ( 10 f 10 r NDAY)  ND 
10  FORMAT <6Xr 14) 

DECODE ( 10 » 10 » NSHFT)  NS 

DECODE < lOt 20f NHM)  NH»NM 
20  FORMAT <6X*I2t>I2) 


ADD  24  TO  HRS  LT  17  ON  SHIFT  2 
IF < NS. EG. 2. AND.NH.LT .17)  NH=NH+24 


CALCULATE  DAY  OF  TEST.  DAY1  EG  0. 
ND=ND-218 

CALCULATE  MINS. 
MINS=ND*24*60+NH*40+NM 


RETURN 

END 


ki 

t 
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PROGRAM  STEP15(UNIT8Af  UNIT!  4  fOUTI  1.5  f 0UTC1 5 f UNIT 1 5 f  OUTPUT. 
+  T APE i=UNIT8A  f T APE2=UNIT14  f T AF‘E3=0UTI 1 5  f 

+  T APE4=0UTC1 5  f  T APE5=UNIT 15  f  T APE6=0UTPUT  > 

purpose:  combines  the  lighter  times  file  and  the  cargo 

TIMES  FILE  INTO  ONE  FILE. 

LOGICAL  NPRINT f NSTOP f NST0P1 f MATCH f FLAG 

DIMENSION  K0DE(2) f LIGHTER (15) fNCARG0(23> fNEND(2> 

+  fNTEST1(4) fNTEST2(4> 

l  OMMON/TBLUNIT/NUNIT1 f NUNIT2  f NUNIT3  f NUNIT4  f NUN ITS  f NUNIT6 

INITIALIZE 

NUNIT1=1 

NUNIT2=2 

NUNIT3=3 

NUNIT4=4 

NUNIT5=5 

NUNIT6=A 

NPRINT=.FALSE. 

NSTOP*  .FALSE. 

NSTOP1*. FALSE. 

MATCH*  .FALSE. 

SET  KODE  TO  READ  BOTH  FILES 
KODE< 1  )  =  1 
KODE (2) =2 

10  CONTINUE 

READ  LIGHTER  AND/OR  CARGO  RECORDS. 

CALL  READ ( KODE f LIGHTER f NCARGO f NEND ) 

CHECK  FOR  EOF  IN  ANY  FILE. 

CALL  STOP  <  NEND f NSTOP  f NST0P1 , KODE ) 

IF (NSTOP)  GOTO  30 

SETUP  MATCH  KEYS 

CALL  SETUP (LIGHTER  *  NCARGO  f  NTEST 1 f NTEST2 ) 

COMPARE  LIGHTER  AND  CARGO  RECORDS. 

CALL  COMPARE ( NTEST1 * NTEST2 f MATCH f NFAIL1 f NFAIL2 ) 

CHECK  FOR  A  MATCH 
IF(MATCH)  GO  TO  20 

THE  MATCH  FAILED.  SELECT  WHICH  FILE  TO  READ. 

CALL  SELECT ( NFAIL1 f NFA1L2 f  KODE ) 
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WRITE  AN  INCOMPLETE  RECORD*  IF  ANY 
CALL  RPTINC ( KODE *  L IGHTER *  NCAR60 r NPRINT ) 

START  OVER  AND  READ  A  NEW  FECORD 
GO  TO  10 


20  CONTINUE 

CALL  SEQ ( NCARGO ( 7 ) *  NCARGO <  23  >  ,  FLAG  > 

IF (FLAG)  GO  TO  25 

KODE ( 1 ) =1 

K0DE(2>=0 

NZ9=4R0000 

CALL  SEQ  <  NZ9  *  0  *  FLAG ) 

NPRINT=. FALSE. 

GO  TO  10 
25  CONTINUE 

A  MATCH  WAS  FOUND 

COMPUTE  TIME  FROM  THE  BEGINNING  OF  THE  TEST 
CALL  CONVERT (NCARGO (2 ) *NCARG0<3>  * NCARGO < 19 > ,NTIME> 
WRITE  A  COMPLETE  RECORD. 

CALL  RPTCOM (LIGHTER t NCARGO » NTIME » NPRINT ) 

SET  KODE  TO  READ  A  NEW  CARGO  RECORD 

K0DE(1)=0 

KODE ( 2 ) =2 

READ  A  NEW  CARGO  RECORD  AT  THE  BEGINNING 
OF  THE  PROGRAM 
GO  TO  10 


30  CONTINUE 

CHECK  FOR  EOF  IN  BOTH  FILES. 
IF(NSTOPl)  GO  TO  40 


WRITE  INCOMPLETE  RECORDS 

CALL  RPTINC  <  KODE  >  LIGHTER » NCARGO  *  NPRINT ) 

READ  NEW  RECORD 

CALL  READ  <  KODE * LIGHTER  *  NCARGO  *  NEND ) 
CHECK  FOR  EOF 

CALL  STOP ( NEND  *  NSTOP  r  NST0P1 *  KODE ) 


CONTINUE  STOP  PROCESS. 
GO  TO  30 
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40  CONTINUE 

END 
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SUBROUTINE  READ < KODE r LIGHTER , NCARGO r NEND ) 


purpose:  to  read  a  record  from  the  lighter  times  file  and/or 

THE  CARGO  TIMES  FILE. 

LOGICAL  FIRST 

DIMENSION  KODE < 2 ) » LIGHTER < 15 ) , NCARGO <  23  >  » NEND ( 2 ) 
COMMON/TBLUNIT/  NUN IT 1 »NUNIT2»NUNIT3»NUNIT4»NUNIT5»NUNIT6 
DATA  FIRST/6H.TRUE./ 

REWIND  THE  FILES  THE  FIRST  TIME  THRU. 

IF< .NOT. FIRST)  GO  TO  10 
REWIND  NUNIT1 
REWIND  NUNIT2 
REWIND  NUNIT3 
REWIND  NUNIT4 
REWIND  NUNIT5 
FIRST=. FALSE. 

10  CONTINUE 

IF  K0DE=1  READ  THE  LIGHTER  TIMES  FILE 
IF <  KODE(l)  .NE.  1  )  GO  TO  20 
READ(NUNITl)  LIGHTER 
NEND< 1 ) “LIGHTER ( 1 ) 

20  CONTINUE 

IF  K0DE=2  READ  THE  CARGO  TIMES  FILE 
IF (  K0DE(2)  .NE.  2  )  GO  TO  30 
READ(NUNIT2)  NCARGO 
NEND (2) =NCARGO ( 1 ) 

IF<  E0F<2)  )  40»30 
30  CONTINUE 

RETURN 

40  CONTINUE 

NEND (2) -4RZE0F 


RETURN 

END 
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SUBROUTINE  COMPARE < NTEST1 »NTEST2 *  MATCH » NFAIL1 * NFAIL2 ) 

purpose:  determines  if  two  records  match  on  four  match  keys 

( I  .E.  FACILITY  ID  *  LIGHTER  TYPE  t  LIGHTER  ID*  AND 
CARGO  ID).  IF  NO  MATCH*  RETURNS  TO  THE  MAIN  PROGRAM 
THE  FIRST  KEY  WHERE  THE  MATCH  FAILED. 

LOGICAL  MATCH 

DIMENSION  NTEST1 (4) *NTEST2<4> 

COMPARE  THE  FOUR  MATCH  KEYS. 

DO  10  J=1 *4 

IF (NTEST1 < J)  .EG.  NTEST2(J)>  GO  TO  10 

THE  MATCH  FAILS. 

MATCH*. FALSE. 

NFAIL1=NTEST1< J> 

NFAIL2=NTEST2(J> 

RETURN 

10  CONTINUE 

A  MATCH  WAS  FOUND 
MATCH*. TRUE. 


RETURN 


on  on  no  noon 
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SUBROUTINE  SETUP < LIGHTER r NCARGO » NTEST 1 r NTEST2 ) 

PURPOSE:  TO  CONSTRUCT  TWO  ARRAYS  WITH  FACILITY  IDr  LIGHTER  TYPE t 
LIGHTER  IDr  AND  CARGO  ID* 

DIMENSION  LIGHTER (15) * NCARGO (23) rNTESTl<4> rNTEST2<4> 

CONSTRUCT  ARRAY  FROM  LIGHTER  TIMES  FILE* 

NTEST1 < 1 >=LIGHTER< 1 ) 

NTEST 1 < 2 ) “LIGHTER < 4 ) 

NTEST1 (3>=LIGHTER(5> 

NTEST 1 (4)=LIGHTER< 15) 

CONSTRUCT  ARRAY  FROM  CARGO  TIMES  FILE* 

NTEST2< 1 )=NCARGO< 1 ) 

NTEST2  <  2  >  =NCARGO  <  5 ) 

NTEST2 ( 3 ) =NCARGO  <  6 ) 

NTEST2 <  4 ) =NCARGO ( 7 ) 


RETURN 

END 


i 


m 
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SUBROUTINE  SEQ ( NCARGO • NSEG • FLAG ) 

purpose:  to  make  sure  the  SEQ  number  increases  for  the  same 
CARGO  ID. 

LOGICAL  flag 

c 

BATA  NCARGOP/ 4R0000/ 

BATA  NS EQF/O/ 

C 

FLAG= . TRUE . 

C 

IF (NCARGO  .EQ.  NCARGOP  .ANB.  NSEQ  .LE,  NSEQP)  FLAG=. FALSE. 

C 

NCARGOP=NCARGO 

NSEQP=NSEQ 

C 

RETURN 

ENB 
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SUBROUTINE  RF’TINC  ( KOBE  >  LIGHTER  >  NCARGO  ?  NF'RINT  ) 

PURPOSE:  WRITES  AN  INCOMPLETE  LIGHTER  OR  CARGO  RECORD ♦ 
LOGICAL  FIRST t NPRINT 

DIMENSION  KODE  <  2  >  » LIGHTER  <  15 ) * NCARGO  <  23  > 

COMMON/TBLUNIT/NUNIT1 > NUNIT2 > NUNIT3 » NUNIT4  f NUNIT5 r NUNIT6 

DATA  FIRST/6H. TRUE ♦ / 

PRINT  HEADER  ON  FIRST  CALL 
IF< .NOT. FIRST)  GO  TO  20 
XDATE*DATE ( JDUMMY ) 

XTIME=TIME< JDUMMY) 

WRITE (NUN I T3* 10)  XDATE » XTIME 
10  FORMAT ( 1H1 t 18HINC0MPLETE  RECORDS , 2 ( 5X > A10 ) ) 

FIRST*. FALSE. 

20  CONTINUE 

DETERMINE  WHICH  RECORD  TO  OUTPUT. 

IF ( KODE ( 1 )  .NE.  1)  GO  TO  50 
IF( .NOT. NPRINT)  GO  TO  30 
NPRINT*. FALSE. 

RETURN 

30  CONTINUE 

NPRINT*. FALSE. 

WRITECNUNIT3*40)  LIGHTER 

40  FORMAT < IX » 7HLIGHTER > 10(3X»R4)»3(3XrI4) r  2( 3X  »R4 ) ) 

RETURN 


50  CONTINUE 

WRITE ( NUNIT3 1 60 )  NCARGO 

60  FORMAT ( IX » 6HCARG0  r ?(R4» IX) >6< I4» lXr R4r IX) >R4* lXr 14) 


RETURN 


no  on  n  o  no  on  non  non 


SUBROUTINE  RPTCOH (LIGHTER  t NCARGO *  NTIME  > NPRINT ) 

PURPOSE:  TO  WRITE  A  COMPLETE  LIGHTER  AND  CARGO  RECORD  * 

LOGICAL  FIRST r NPRINT 

DIMENSION  LIGHTER<15>  » NCARGO < 23 ) 

COMMON/TBLUNIT/  NUNIT1 »NUNIT2>NUNIT3> NUNIT4 > NUNIT5 » NUNIT6 

DATA  FIRST/6H.  TRUE ♦/ 

WRITE  HEADER  ON  FIRST  CALL 
IF ( .NOT  .FIRST)  GO  TO  20 
XDATE=DATE  <  JDUMMY ) 

XTIME=TIME< JDUMMY) 

WRITE (NUN I T4» 10)  XDATEtXTIME 
10  FORMAT < 1H1 1 16HC0MPLETE  RECORDS , 2 ( 5X * A10) ) 

FIRST=. FALSE. 


20  CONTINUE 

WRITE  A  COMPLETE  RECORD 

WR I TE ( NUN I T4 » 30 )  L I GHTER r NCARGO < 4 ) r (NCARGO( J) » J=9»23> 

30  FORMAT <lXrR4rR3rRlrR4rR4rRlrlXrRlrlXrRlrlXrR4rlXr 

+  R4r3(lXfI4)flXfRA,lX,R4rlXfR2f6(lXfR4flXrI4)flX,R4flXfRAr 

+  IX, II) 

WRITE<NUNIT5)  LIGHTER, NCARGO< 4) r <NCARGO( J>  , J=9,23) ,NTIME 

SET  KOBE  TO  TRUE.  THE  PRESENT  LIGHTER  RECORD  WAS  COMPLETE. 
NPRINT=. TRUE. 


RETURN 

END 
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SUBROUTINE  STOP < NEND » NSTOP i NST0P1 > KOBE ) 


PURPOSE:  TO  DETERMINE  IF  EOF  IN  ANY  FILE.  TO  DETERMINE  IF 
EOF  IN  ALL  FILES.  SETS  KOBE  TO  INDICATE  RECORDS. 

LOGICAL  NSTOP rNSTOPl 

DIMENSION  NEND <  2  >  » KODE < 2 ) 

TEST  FOR  AT  LEAST  ONE  EOF 
IF < NSTOP)  GOTO  30 
DO  10  J=lf2 

IF <NEND< J>  .EG.  4RZE0F)  GOTO  20 
NO  EOF  FOUND 
10  CONTINUE 

ALL  FILES  CONTAIN  DATA 
NSTOP*. FALSE. 

RETURN 


20  CONTINUE 

SET  KODE  FOR  AT  LEAST  ONE  EOF 
NSTOP*. TRUE. 

30  CONTINUE 

CHECK  FOR  EOF  IN  LIGHTER  FILE 
KQDE( 1 >=0 

IF< NEND ( 1 ) »NE . 4RZE0F )  K0DE<1)*1 

CHECK  FOR  EOF  IN  CARGO  FILE 
K0DE<2)=0 

1F<NEND<2) .NE.4RZE0F)  K0DE<2)=2 


CHECK  FOR  EOF  IN  ALL  FILES. 

IF ( KODE < 1 ) ♦ EQ . 0 ♦ AND . KODE ( 2 ) .EQ.O)  NST0P1* . TRUE . 
C 

RETURN 

END 


[I 
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PROGRAM  URTRPKTAPEl  ,  OUTPUT » TAPE£=OUTPUT) 

PURPOSE:  TO  READ  THE  SORTED  LIGHTER/CARGO  PILE ,  COMPUTE 

STATISTICS  AND  WRITE  A  REPORT.  FOR  EACH  FACILITY- 
DATE  AND  SHIFT  -  STATISTICS  ARE  ACCUMULATED  ON 
LIGHTER  TYPES. 

LOGICAL  FIRST  » KPGBR -  SAME 

DIMENSION  N<32) » SUMTY <9-2) » SUMSQTY (  9,2) , NOTYF I  9 ) , NOTYR ( 9 ) 

DATA  BLANK/ 1H  / 

REWIND  1 

FIRST= . TRUE . 

INITIALIZE  BREAK  KEYS 
OFAC=BLANK 
ODATE=BLANK 
OSHIFT =BLANK 

20  CONTINUE 

READ  A  LIGHTER/CARGO 
READ ( 1 )  N 
IF (  EOF ( 1 )  )  30,40 
30  CONTINUE 

CALL  CHECKIN, SAME) 

CALL  PRNTST ( SUMTY , SUMSQTY , NOTYF , NOTYR ) 

STOP 

40  CONTINUE 

CALL  CHECKIN, SAME) 

KPGBR=. FALSE. 


CHECK  FOR  PAGE  BREAK  ON  FACILITY , DATE , OR  SHIFT. 

IF!  INtl)  .NE.  OFAC )  .OR.  I N < 2 )  .NE.  ODATE)  .OR. 

+  INI3)  .NE.  OSHIFT)  )  CALL  PGBRKIFIRST, OFAC, ODATE, OSHIFT, N, 

+  KPGBR, OLTRTY,OFR, SUMTY, 

+  SUMSQTY, NOTYF, NOTYR, SAME) 

IF I KPGBR)  GO  TO  20 


CHECK  FOR  LIGHTER  TYPE  OR  FORWARD  OR  RETROGRADE  BREAK 
IF!  N! 4 )  .EQ.  OLTRTY)  GO  TO  50 
QLTRTY=N!4) 

0FR=N!8) 

CALL  PRNTST I SUMTY , SUMSQTY , NOTYF , NOTYR ) 
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CALL  INTY  <  SUMTY ,  SUMSGTY , NOTYF » NOTYR ) 

CALL  ACCTY ( SUMTY  >  SUMSGTY  >  NOTYF  y  NOTYR  » N  r SAME ) 
CALL  PRNIND ( N »  SAME ) 

GO  TO  20 
50  CONTINUE 

IF (  N<8>  .EQ.  OFR >  GOTO  60 
OFR=N  <  8 ) 

CALL  ACCTY ( SUMTY » SUMSGTY y NOTYF  t NOTYR y N y SAME ) 
CALL  PRNIND(NySAME) 

GO  TO  20 


60  CONTINUE 

CALL  PRNIND(NySAME) 

CALL  ACCTY (SUMTY r SUMSGTY , NOTYF y NOTYR rN» SAME) 
GO  TO  20 


SUBROUTINE  ACCTY ( SUMTY , SUMSQTY » NOTYF » NOTYR » N  »  SAME ) 


purpose:  compute  and  accumulate  lighter  and  cargo  type 

+  STATISTICS. 

LOGICAL  SAME 

DIMENSION  SUMTY <9 » 2 )  » SUMSQTY (9»2>  »N ( 32 ) r  L  <9 ) » NOTYR ( 9 ) >  NOTYF  <  9  > 

PUT  NUMBERS  FOR  STATISTICS  INTO  ONE  ARRAY  *L * 

L(1)=N<11) 

L(2)=N<12) 

L(3)=N< 13) 

L  <  4 ) =N ( 18 ) 

L(5)=N<20) 

L  <  6 ) -N  <  22 ) 

L(7)=N<24) 

L(8)=N<26) 

L(9)-N(28) 

NSTART=1 

IF (SAME)  NSTART=4 

CHECK  FOR  FORWARD  OR  RETROGRADE. 

IF <  N<8)  . EQ.  4R  F  )  GO  TO  30 

RETROGRADE  STATISTICS 
DO  20  J=NSTART>9 

IF (  L(J)  .EQ.  -999  .OR.  N<31>  .NE.  1  )  GO  TO  10 
NOTYR  <  J ) =NOTYR  <  J )  + 1 
SUMTY ( J  *  2 ) =SUMTY ( J » 2 )  +  L(J) 

SUMSQTY ( J»2)=SUMSQTY(Jt2)  +  L(J)  *  L(J) 

10  CONTINUE 
20  CONTINUE 

RETURN 


30  CONTINUE 

FORWARD  STATISTICS 
DO  50  J=NSTART»9 

IF (  L ( J )  .EQ.  -999  .OR.  N(31)  .NE.  1  )  GO  TO  40 
N0TYF(J)=N0TYF(J)+1 
SUMTY ( J» 1 >=SUMTY  <  J*  1 )  +  L(J> 

SUMSQTY  < J» 1 )=SUMSQTY  <  J*  1  >  +  L(J)  *  L(J) 

40  CONTINUE 
50  CONTINUE 


RETURN 


o  o  no  non 


SUBROUTINE  INTY ( SUMTY* SUM5GTY * NOTYF * NOTYR ) 

purpose:  initialize  statistics  parameters. 

DIMENSION  NOTYF  <  9 ) *  NOTYR  <  9  >  * SUMTY ( 9  *  2  >  *  SUMSQTY (9  r2) 

DO  10  J=l*9 
NOTYF < J>=0 
NOTYR ( J)=0 
10  CONTINUE 


DO  30  1=1*9 
DO  20  J=1 *  2 

SUMTY ( I  *  J) =0 
SUMSQTY  < I » J ) =0 
20  CONTINUE 
30  CONTINUE 


RETURN 

END 
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SUBROUTINE  F'GBRK (FIRST » OFAC » ODATE » OSHIFT f N f KPGBR  f  OLTRTY  »  OFR f 
+  SUMTY  f SUMSQTY  f  NOTYF  f NOTYR  f SAME ) 

purpose:  to  write  page  headings  and  to  print  lighter/cargo 

RECORDS  AND  STATISTICS. 

LOGICAL  FIRST fKPGBRfSAME 

DIMENSION  N ( 32) ? SUMTY ( 9  f  2 ) ? SUMSQTY ( 9  f  2) » NOTYF (9 ) f  NOTYR ( 9 ) 

IF (FIRST )  GO  TO  10 

PRINT  LIGHTER/CARGO  STATISTICS. 

CALL  PRNTST ( SUMTY f SUMSQTY » NOTYF  f  NOTYR ) 


10  CONTINUE 

PRINT  NEW  PAGE  HEADING 
FIRST=. FALSE. 

COMPUTE  DAY  OF  AUGUST 
DECODE ( 10f20fN(2))  ND 
20  FORMAT (7Xf 13) 

ND=ND-212 

WRITE(6f30)  N  (  1 )  f ND f  N(  3 ) 

30  FORMAT ( 1H1 f 10Xf26HLIGHTER/CRANE  CYCLES  TIMESf  /  f  IX  f 
+  11HFACILITY  IDf1XfR4f3Xf  8HDATE  AUG r IX f 13 f 3X f 

+  5HSHIFT f 1XfR4f  /) 


WRITE(6f40) 

40  FORMAT ( 13X» 1HPf2Xf 1HF t 11Xf4HLRDPf lXr 4HLRDY f IXf  4HLRDP f  19Xf  4HLD0Cf  r 

+  6X f 4HLDLK ?6Xr 4HLIFT f  6X  f 4HCPSN f  6X  f 4HLAND f  6X  f 4HLUND t  /  , 

+  1Xf3HLTRf2Xf3HLTRf2Xf1HCf1Xf1H0f2Xf1H/f12Xf1H-f3Xf1H-f  nfl 

+  1Xf2HPRf2H  -f  IX  f 2HPR f  IX  f 4HCRG0f IXf 4HCRG0 f  IX  f 2H0P »6X f 

+  4H-  PRf7Xf 1H-f9Xf 1H-f9X  f 1H-f9X  f 1H- f9X  f 1H- f  3X  f  4HDELY  f  IX  f  -- 

+  4HDELY  t  /  *  1Xf4HTYPEf2X  f  2HIDf2X  f  3HY  Sf2Xf1HRf5H  LRDY  *  '-A 

+  5H  LRDPf 5H  LRDYf5H  LRDPf 5H  LRDPf 5H  TYPEf4H  ID  f  4H  IDf 

+  5H  LD0C»5H  LDUNfSH  LDLKfSH  LDOCf 5H  LIFT f5H  LDLKfSH  CPSNf  ‘  < 

+  5H  LIFTf5H  LAND  f5H  CPSNfSH  LDUNfSH  LANDfSH  STRTfSH  TYPEf  -3* 

+  /  ) 

0LTRTY=N<4) 

0FR=N<8) 


PRINT  LIGHTER/CARGO  RECORD 
CALL  PRNIND(NfSAME) 


INITIALIZE  LIGHTER  TYPE  STATISTICS 
CALL  INTY < SUMTY  f SUMSQTY f NOTYF  f NOTYR ) 


ACCUMULATE  LIGHTER  TYPE  STATISTICS 

CALL  ACCTY  (  SUMTY  >  SUMSQTY  ,  NOTYF  » NOTYR  , N ,  SAME  ) 

OFAC=N ( 1 ) 

0DATE=N<2) 

0SHIFT=N<3) 

KPGBR=.TRUE» 


RETURN 


SUBROUTINE  PRNIND  <  N  . SAME ) 

purpose:  to  write  individual  lighter/cargo  records 

LOGICAL  SAME 

DIMENSION  N(32) 

IF  DELAY  RECORD 

IF <  N<31>  .EG.  1  )  GO  TO  20 

THEN  PRINT  DELAY  PART  OF  THE  RECORD 
WRITE<6» 10  )  N <  29 ) » N  <  30 ) 

10  FORMAT < 116X.R4. 1X.R4) 

RETURN 

ELSE  PRINT  THE  COMPLETE  RECORD 
20  CONTINUE 

DECODE <10.30»N<6) )  N6 
30  FORMAT (6X.R1.3X) 

DECODE ( 10»40»N<7) >  N7 
40  FORMAT  <  6X » R2 » 2X ) 

DECODE ( 10 » 40  . N  < 16 ) )  N16 

IF (SAME)  GO  TO  60 

WRITE<6»50)  <N(I) .1=4.5) .N6.N7. <N(I> .1=8.15) .N16. <N< I) .1=17.30) 

50  F0RMAT(1X,R4»1X.R4.1X.R1.1X.R2.1X.R1.1X.R4.1X.R4.1X.I4.1X.I4. 

+  1X.I4.1X.R4.1X.R4.1X.R2.1X.R4.1X.I4.1X.R4.1X.I4.1X.R4.1X. 

+  14 . IX. R4 .1X.I4.1X. R4 .IX. 14. IX. R4 .IX. 14. IX. R4 . IX . R4 ) 


RETURN 
60  CONTINUE 

WRITE<6»70)  (N< I >.1=14.15) .N16 . (N( I >. 1=17-30 ) 

70  FORMAT ( 43X. R4» 1X.R4.1X.R2.1X.R4.1X.I4.1X.R4.1X. 
+  14. IX. R4. IX. 14. IX. R4. IX. 14. IX. R4 »1X. 

+  I4.1X.R4.1X.I4.1X.R4.1X.R4) 


RETURN 


SUBROUTINE  PRNTST ( SUMTY ,  SUMSQTY >  NOTYF , NOTYR ) 


PRUPOSEJ  COMPUTE  AND  PRINT  LIGHTER  TYPE  STATISTICS. 

DIMENSION  SUMTY ( 9 » 2 )  * SUMSQTY (  9  >  2  ) » XBAR ( 9  f  2 ) f  SD  <  9  f  2  > t 
+  NOTYF  <  9  >  f NOTYR  <  9 ) 

DO  30  J=l,2 
DO  20  1=1 f? 

N=NOTYF  < I > 

IF < J  .EG .  2)  N=NOTYR< I ) 

IF(N  .NE.  0)  GO  TO  10 
XBARdf  J>=0. 

SD< I f J)=0. 

GO  TO  20 

10  CONTINUE 

XBAR < I , J ) =SUMTY  < I f  J  > /N 

SD<Ir J)=SUMSGTY(If J)/N  -  XBAR ( I » J > *XBAR ( I f J) 

20  CONTINUE 

30  CONTINUE 

DO  50  1  =  1  r  9 
DO  40  J=1 » 2 
Z9=SD  <  I  f  J ) 

SD( I f J)=SGRT  <Z9) 

40  CONTINUE 

50  CONTINUE 


WRITE<6f60) 

60  FORMAT <3Xf7HF0RWARD) 

WRITE(6»70)  NOTYF 

70  FORMAT (10Xf1HNf17XfI4f1XfI4f1XfI4f19Xf6(I4f6X)) 
WRITE<6f80)  (  XBAR<If1)fI=1f9)f(SD<Jf1)fJ=1f9) 
80  F0RMAT<10Xf4HMEANf13Xf3<F5»1) f18Xf6(F5.1f5X>/ 

+  10X»4HSD  f 13X f 3 ( F5 «1>f18Xf6( F5 .If  5X ) ) 


WRITE(6r 90) 

90  FORMAT < 3Xf 10HRETR0GRADE > 

WRITE(6f70>  NOTYR 

WRITE(6f80)  <  XBAR< I  f  2 ) f 1=1 f9 ) t  ( SD ( J  f  2) f J=1 f  9) 


RETURN 


SUBROUTINE  CHECK<N> SAME) 

purpose:  to  determine  if  present  lighter  record  is  the  same 

AS  THE  PREVIOUS  LIGHTER  RECORD. 

LOGICAL  SAME 
DIMENSION  N<32) »NOLD< 10) 

DATA  N0LD/10*1/ 

SAME®. TRUE. 

DO  10  J=lflO 

IF (  N< J)  .EQ.  NOLD(J)  )  GO  TO  10 
DIFFERENT  LIGHTER  RECORD  FOUND 
SAME®. FALSE. 

10  CONTINUE 

SAVE  PRESENT  LIGHTER  PARAMETERS 
DO  20  J=l»10 
NOLD( J)=N< J) 

20  CONTINUE 


RETURN 


APPEND 

CRANE  CYC! 
PROGRAM  L 


L5TGT  7 CM60000  7  SPUU  7  T500 . GST 

TASK ( TN=LQTS 7  TA=12345 7  QS=ORISPMD 7 TR  -TS 7  PI=6ST ) 

COMMENT,  *****  CTL ,  STMTS,  ON  GEN  J4CYCLE  DATA  ***** 

ATT ACH ( S2K  7  S2K260  7 ID=SYS2000  7  MR=1 > 

REQUEST  (  RETRS2K  7  *F‘F  ) 

S2K ( CR=77 ) 

ATTACH (MAGIC  7 MAGICNUMBERGENERATOROBJECT 7 ID=LOTS »MR=1 > 

REQUEST ( RETRMGC 7  *PF ) 

MAGIC ( RETRS2K 7  RETRMGC ) 

REWIND (RETRMGC) 

REQUEST ( RETRSTD >  *PF ) 

FILE(RETRMGC7MRL~110  7RT=Z7BT==C7FL  =  110) 

FILE ( RETRSTD  7  MRL= 1 1 0  7  RT=Z 7  BT=C  7 FL*1 1 0 ) 

SORTMRG ,  SORT  RETRMGC  TO  RETRSTD  BY  MAGIC  NO. 

CATALOG ( RETRSTD  7  JLMT4ACARDF 7 ID=LOTS ) 

EX  I T  ♦ 

CATALOG  (RETRS2K  7  JLMT4  AC  AR'DFUNSQR  TED  7 ID=LOTS ) 

*EOR 

USER 7 LOTS 7  SHARED  DBN  IS  JLMT4A; 

REPORT  FILE  IS  RETRS2K 7 

LI/TITLE  L(4)7L(3>7L(1>7L(4)7L(1>7L(4)7L(4>7L(4)7L(4)7L(4>7L(2) 
L  ( 4  )  7  L  ( 4  )  / 

CIOIO7CIIIO7CII2O7CI3057CI3IO7CI32O7CI3257 
Cl 330  7  C1335  7  C1340  7  Cl 365  7  Cl 4 10  7  Cl  420  7 
OB  CIOIO7CUIO7CH2O7CI42O 
WH  ( (C1410  EQ  LDOC  OR  C 1410  EQ  DELY) 

AND  (C1010  EQ  COD  OR  C1010  EQ  TCDF  OR  C1010  EQ  ADF' 

OR  C1010  EQ  ECWY  OR  C1010  EQ  BBCS  OR  C1010  EQ  EDP  >  ) 

AND  ( C1370  EQ  O7 

*EOR 

SORT 

FILE  7  SORT=RETRMGC 7  OUTPUT =RETRSTD 

FIELD7FACID(4  747  DISPLAY)  7  DATE  ( 11 7  37  DISPLAY)  7  SHIFT  ( 17  7.1 7  DISPLAY) 
7  CARID( 21 7  4  7  DISPLAY ) 7  CY ( 28  7 1 7  DISPLAY ) 7  DISCAR ( 32  7  4  7  DISPLAY ) 7 
7 DIS ID (3?747  DISPLAY ) 7RECCAR( 46 7 4 fDISPLAY >  7 RECID( 53 7 4 7 DISPLAY ) r 
7DEUICE(A0747DISPLAY) 7UNK(67  7  27DISPLAY) 7 NAME ( 72 7 4 7  DISPLAY ) 7 
7  TIME ( 79  7  4  7 DISPLAY ) 7 NTIME ( 86 7 6 7  DISPLAY ) 

KEY7FACID(A7DISPLAY>  7NTIME(A7DISPLAY) 7NAME(D7DISPLAY) 

END 

*EOR 

*EOF 
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PROGRAM  MAGIC < TAPE 1>  T APE2  r  OUTPUT  r  TAPEA=OUTPUT  ) 


DIMENSION  N ( 1 4 ) 

REWIND  1 

READ  < 1 r 10) 

10  FORMAT  </ ) 

12  CONTINUE 

READ (1*20)  (N(I) *1=1*13) 

IF ( EOF ( 1 ) )  50*15 
15  CONTINUE 

20  FORMAT ( 3X *R4,3X *R3*3X »R1 *3X*R4*3X*R1 *5<3X*R4> *3X*R2* 

+  2  <  3X  *  R4 )  ) 

CALL  CONVERT <N(2>  *N<3) *N< 13) »N( 14) » NT I ME) 

WRITE ( 2  *  30 )  <  N ( I ) » 1  =  1  *  12 ) »  NTIME»N(.1.4) 

30  FORMAT (3X»R4*3X*R3*3X*R1*3X*R4*3X*R1*5(3X*R4)*3X*R2*3X* 
+  R4  » 3X  *  14  *  3X » 16 ) 

GO  TO  12 
50  CONTINUE 


*  *  *•  *  *•  *  * 


SUBROUTINE  CONVERT ( NDAY , NSHFT , NMM , MINS ,  NT I ME ) 

PURPOSE!  CONVERTS  DAYS, SHIFT, MRS  AND  MINS  TO  MINS  FROM  BEGINNING 
OF  THE  TEST 

DECODE (10, 10, NDAY)  ND 
10  FORMAT  <  7X , 13 ) 

DECODE! 10, 15, NSHFT)  NS 
15  FORMAT  <  9X , 1 1 ) 

DECODE  <10,20, NHM )  NH , NM 
20  FORMAT ( 6X ,12,12) 


ADD  24  TO  HRS  LT  17  ON  SHIFT  2 
IF ( NS . EQ . 2 . AND . NH ♦ LT ,17)  NH=NH+24 


CALCULATE  DAY  OF  TEST ♦  DAY1  EQ  1. 

ND=ND-217 

CALCULATE  MINS.  ADD  10000  SO  ALL  MINS  WILL  BE  5  CHARCTERS 
LONG.  THIS  IS  IMPORTANT  FOR  THE  BCD  SORT  WHICH  SORTS  ON  BLANKS. 
IN  THE  BCD  SORT  A  BLANK  IS  GT  A  NINE. 
MINS=ND*24*60+NH*60+NM+10000 

*  ADD  24  TO  HRS.  <  7  ON  SHIFT  2 

NTIME  =  NH  *  100  +  NM 

IF  (NS  .EQ.  2  .A.  NH  .LT.  7)  NTIME  =  (NH+24)  *  100  +  NM 


RETURN 

END 


u 


u 
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10/13/78 


13,47.35 


CYCLOPS 


PAGE  NO ,  1 


12345678? 
over lay  <  'cyclovr'  ?  0  •  0 ) 

program  cyclops  (cardf?  scfile?  dbintr?  scintr>  report?  output? 
tapel=cardf?  tape2=scf i le ?  tape3=dbint r ?  tape4=scint r ? 
t3pe5=report ?  tspe6=output ?  csidis=200?  tape7=csidts ) 


►  Csll  overlay(l?0)  snd  overlay(2?0)  to  set  up  'data  base 

)  intermediate  file"  (DBINTR)?  snd  "selection  criteria  intermedist 

)  file"  (SCINTR)?  respectively, 

) 

)  Csll  overlsy(3?0)  to  produce  3  statistical  report  on  selected 

)  cycles?  and/or  the  selected  cycles  themselves?  according  to  the 

1=  setting  of  sense  switches  1?  2?  snd  3 — as  indicated  below. 


44444444444444444444444444444444444444444444444444444 

4  This  Program  was  developed  by  Gary  S.  TruJillo  4 

44444444444444444444444444444444444444444444444444444 


# - 

implicit  integer  <a-z> 
common  /r uninfo/  cdate?  ctime 

4 - 


call  sswtchd?  swl)  4  produce  statistics  report 

call  sswtch(2?  sw2)  4  print  cargo  cycle  data 

call  sswtch<3?  sw3)  4  print  expl,  SCs  &  sel.  cycle  data 

if  (swl==2  &  sw2==2  &  sw3==2 )  -C 

call  remark( 'error — no  options  selected  via  sense  switch") 
stop 

> 

call  time(ctime)  4  get  time  %  date  from  system 

call  date(cdate) 

rewind  NREPORT  ?  write  <NREP0RT?10)  ctime?  cdate 

write  (NERRRPT?10)  ctime?  cdate 

call  overlay < "cyclovr '? 1 ? 0 )  4  create  DBINTR  file 

call  overlay( "cyclovr" ?2>0)  4  create  SCINTR  fil- 

call  overlay< 'cyclovr ' ?3?0)  4  generate  statistical  reports 

10  format <" lbesinnins  execution  "?2al0> 


10/16/78 


15.06.05 


CRDBINT 


PAGE  NO 


1 


1  23456789 

overlay( "cyclovr ' r  1  f  0  ) 

program  crdbint  ♦  create  ‘data  base  intermediate  file 

* - 

implicit  integer  (a-z) 

common  /dbinfo/  dbname?  dbdatex  dbtime 
common  /run info/  cdste»  ctime 
inteder  paddindC63 
data  paddind/6#0/ 
data  filname  /"dbintrV 
data  bodcode  /BOG/ 

* - 


if  <sfetidwc< dummy )  ==  ERR)  -C  #  input  cargo  ID's  8  weidht,  codes 
call  re«iark(  'error — cargo  id  weiaht  file  is  null7) 
stop 

> 

rewind  NDBINTR 

#  det  one  record  from  cargo  activity 

#  raw  data  file 


rstatus  =  rdcardf < fcltyido  oprdatef  oprshft*  dirmvmtf 
cytyper  sdlfdevf  operidf  wdhtcatf  cystartf  cyduratf 
spclxptf  ldtrseaf  cyinter) 


if 

( rstatus 
return 

==  EOF) 

* 

* 

if  car do  activities  file  is  nullf 
return  without  touchind  DBINTR 

if 

( rstatus 

BOG)  -C 

write  (NERRRPTflO)  #  first  record  not  bedinnind-of-droup 

call  remark (' error  in  crdbint  in  readind  cargo  data  file7) 

stop 

> 


write  (NDBINTR)  filnamer  # 

dbnamer  cdater  ctimer  * 
dbdater  dbtime  * 


name  of  file 

creation  date  arid  time 
data  base  file  creation  info. 


while  (rstatus  "=  EOF)  -C 


if  (rstatus  ==  BOG) 

write  (NDBINTR)  bodcoder 


*  write  header  ^or  each  new  droup 
fcltyidr  oprdatef  oprshftf  paddind 


write  (NDBINTR)  dirmvmtf  cytypei  operidf  sdlfdevr 

wdhtcatr  cystartf  cyduratf  spclxptr  ldtrseaf  cyinter 


rstatus  =  rdcardf (fcltyidr  oprdatef  oprshftf  dirmvmtf 
cytypef  sdlfdevf  operidf  wdhtcatf  cystartf  cyduratf 
spclxptf  latrseof  cyinter) 
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#  Read  "Cardo  Activities  Raw  Data  File’  (CARDF) 


inteder  function  rdcardf  < f p1 > f p2 t f p3 » f p4 t f p5 » f p6 r f p7 * f p8 r f p? ? 

fpl0>fpll»fpl2>fpl3) 

implicit  inteder  (a-z) 

logical  fstcallr  endfile>  clasifar  news anc 

common  /dbinfo/  dbname'  dbdate*  dbtime 

common  /ncdrec/  ncdrec  #  no.  of  CARDF  record 

data  watcode?  cardid'  dxident'  rxidentr  sldev* 

operid»  evtname'  evttime'  ldtrbrk  /9  *  0 /» 
f steal 1/ ♦ true./ »  newsanc/. false./ 


if  ( f steal  1 )  -C 


#  read  file  header  on  first  call 


rewind  NCARDF 

read  (NCARDF'15)  dbname'  dbdate»  dbtime 


bypass  CARDF  creation 


if  (endf ile(NCARDF) )  < 

write  (NERRRPT»20)  #  eardo  activity  raw  data  file  null — 

rdcardf  =  EOF 

return  #  bypass  CARDF  creation 

> 

if  (dbname  ==''•,  dbdate  ==  '  '  !  dbtime  ==  '  ')  < 

write  (NERRRPT » 12)  dbname f  dbdate>  dbtime 

call  remark < ' improper  header  on  cardo  activity  raw  data  file') 
stop 

> 

fstcall  =  .false. 

write  <NREP0RT»25)  dbdate»  dbtime 
write  <NERRRPT»25)  dbdate?  dbtime 


rdcardf  =  OK 
f p13  =  UNINTER 

while  (.true.)  -C 


#  set  default  return  code 

#  cycle  unint.  unless  delay  found 


if  (evtname  ~=  'dely')  <.  ♦  unless  last  record  was  for 

prvwtcd  =  watcode  *  a  delay  event' 

prvedid  =  cardid  #  save  all  important  values 

prvdxid  =  dxident 

prvrxid  =  rxident 

prvsldv  =  sldev 

prvopid  =  operltr 

prvevnm  =  evtname 

prvevtm  =  evttime 

prvltbk  =  ldtrbrk 

> 

read  (NCARDF'10)  facid'  oprdate'  oprshft'  cardid'  cdcycler 
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dxtype*  dxident»  r>:type>  rxident* 
sldev»  operi d»  evtname;  evttime*  ncdrec 


if  < endf  i  1  e ( NCARDF )  )  -C 
rdcardf  =  EOF 
return 


#  siSnal  end-of-f i le 

*  to  caller 


*  CLASIFY  determines  carsio  direction 

*  of-roovement(fp4) *cycle  type(fp5) 

*  and  lighter  break  code  based  on 

*  type  of  discharging  &  receiving 

*  transporters  and  facility  ID 

if  <‘vclasify(f3cid»  dxtype*  rxtype»  #  input  parameters 
f p4 r  fp5»  lstrbrk))  <.  #  output  parameters 

write  (NERRRPT*50)  ncdrec*  facid*  dxtype*  rxtype 
newsync  =  .true.  #  unable  to  classify  record 

next 

> 

wgtcode  =  wdhtcat  (carslid ) 

operltr  =  cvoprid(operid)  #  convert  numeric  code  to  alpha 

if  (operltr  ==  ERR) 

write  (NERRRPT*70)  operid*  ncdrec 

if  (wdtcode  ==  ERR)  < 

write  (NERRRPT*30)  ncdrec*  cargid*  facid*  oprdate*  oprshft 
newsync  =  .true.  #  skip  cycle  if  carsio  ID 

next  t  is  invalid 

> 

evttime  =  minutes (evttime )  #  convert  event  time  to  minutes 


if  (newsync)'  <  #  do  not  calculate  cycle 

♦  if  error  on  previous  record 

newsync  =  .false. 

if  (facid  ==  prvfcid  #  but  if  current  record 

&  oprdate  ==  prvdate  #  begins  a  new  sroup 

&  oprshft  ==  prvshft)  *  process  it  as  usual 


#  check  for  new  group 


if  (facid  M~  prvfcid 
!  oprdate  "=  prvdate 
!  oprshft  M-  prvshft)  < 


*  ***  NEW  GROUP  *** 


if  (evtname  = 
next 


=  'dely')  *  if  1st  record  of  new  sroup 

#  contains  a  delay  events 

♦  Just  ignore  it 


if  (rdcardf 


BOG) 


#  if  previous  record  also  had  a 
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*  different  facility  ID/  date 

*  or  shift  code  from  the  record 

*  immediately  p  recedi  rid  it/ 

*  something  is  probably  wrong. 

write  (NERRRPT/40)  prvfcid/  prvdate/  prvshft/  facid/ 

oprdate/  oprshft/  ncdrec 

fpl  =  prvfcid  =  facid 
f p2  =  prvdate  =  oprdate 
fp3  =  prvshft  =  oprshft 

rdcardf  =  BOG  *  arrange  that  1st  cycle  time 

lstrsea  =  1  *  will  have  lighter  sec*,  of  1 

> 

* - 

else  <  *  ***  NOT  NEW  GROUP  *** 


#  set  SC  parameters  based  on  data  from  previous  record 

if  (evtname  ==  'dely')  <.  #  if  cargo  activity  set 

fpl3  =  INTER  *  contains  'delay*  activity  code/ 

next  *  mark  cycle  as  'interrupted* 

> 

if  (cargid  ==  prvcgid)  < 

write  (NERRRPT/60)  ncdrec/  cargid/  facid/  oprdate/  oprshft 
next  *  duplicate  record — ignore  it 

> 

if  (lgtrbrk  M-  prvltbk)  #  start  new  iighter  seouence 
lgtrsee  =0  #  if  change  of  direction 

fp6  =  prvsldv 
fp7  =  prvopid 
fp8  =  prvwtcd 
fp9  =  prvevtm 
fplO  =  evttime  -  prvevtm 
if  (fplO  <  0) 

write  (NERRRPT/80)  fplO/  ncdrec  #  negative  cycle  time 

if  (dxtype  ==  'lshb'  i  rxtype  ==  ' lshb') 
fpll  -  LSHB 

else  if  (dxtype  ==  'sbbg'  !  rxtype  ==  'sbbg') 
fpll  =  SBBG 
else  fpll  =  UNDEF 


if  (lgtrbrk  ==  DISCHARGE)  < 
if  (dxident  *'=  prvdxid) 
lstrsea  =  0 

> 

else  if  (lgtrbrk  ==  RECEIVE)  -C 
if  (rxident  "=  prvrxid)  # 
lstrsea  =0  # 

> 


#  if  breaking  on  new  discharging 

#  lighter/  see  if  it  has  been 

#  encountered 


same  test  for  receiving 
lighter 


D- 10 


10/16/78 


15*22.48 


RDCARDF 


PAGE  NO.  4 


123456789 


else 

ldtrseo  =  UNDEF 
fpl2  =  ldtrsea 
ldtrsea  =  ldtrsea  +  1 
return 

y 

y 


* 


10  format ( 3x * 

a4r 

* 

f  acid 

3x  t 

a  3 1 

* 

oprdate 

3  xr 

al  i 

* 

oprshf t 

3x  * 

34  T 

* 

cardid 

3  XT 

alt 

* 

cdcycle 

5  ( 3x  t 

34  )  t 

* 

dxtype.  dxident* 

3x  t 

r2 1 

* 

operid 

3x  t 

a4  t 

* 

evtname 

3xt 

i4 1 

* 

evttime 

3x  t 

i6  ) 

* 

ncdrec 

rxtype»  rxiderit*  si  dev 


12  format < 'Oimproper  header  on  cardo  activity  raw  data  file'* 
/'  file  name  divert  as  '»al0» 

/'  creation  date  divert  as  '»al0r 
/'  creation  time  diven  as  '»al0> 


15  format (al0r4x? 2(al0»5x)/>  #  header  record 


20  format ( 'Ocardo  activities  raw  data  file  is  null'* 
' — bypassirtd  intermediate  file  creation') 


25  format < 'Ocreatind  intermediate  file  from  raw  data  file  of  '2al0) 

30  format ( 'Orecord  no.  'ri5»'  of  cardo  activities  raw  data  file  'r 
'contains  invalid  cardo  identifier  ('ra4»')  '» 

/  '  facility  id=  '»al0»'  date®  'ta?r'  shift®  '»a 1) 

40  format < 'Ordcardf  detected  two  consecutive  chandes  in  facility  id  'r 
'date*  or  shift  codes '» 2 ( /5x » 3al0 )t lOx t ' record  no.  '*i5> 

50  format('  record  no.  '» i5»'  of  cardo  activities  raw  data  file'r 
'  contains  an  invalid  code.'* 

/  '  facility  id®  '»al0»'  dischardind  transporter  type®  'ralO? 

'  receivind  transporter  type®  'ralO) 

60  format < 'Orecord  no.  'ri5r'  of  cardo  activities  raw  data  file  '* 

'  appears  to  duplicate  the  immediately  precedind  record' » 

/  '  cardo  id®  '»al0i>'  facility  id®  '»al0r'  date®  'ra9» 

'  shift®  '»al) 


m 


* 

"  i 


4 


*. 

1 


:1 
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70  format ( 'Oinvalid  operator  id  m,*r2r,m  in  record  no.  '* 
i5r'  of  c3rdo  sc  ,ivities  raw  data  file') 

80  f ormat ( ' Onedati ve  cycl<  time  '  >i5* 

'  detected  by  r  rardf  for  record  no.  '  »i5> 
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int ester  function  wahtcat (csid)  *  look  up  S  return  wt .  code  for  CGID 

implicit  integer  (s-z) 
integer  cardtbl CCRGTBLSIZ3 
integer  wsfhttbl  CCRGTBLSIZ3 
real  weiaht 
logical  endfile 
common  /wstcom/  wceountC7T 
data  prvcaid  /0/ 

shiftlr(id)  =  id/2  .a*  3777  77777  77777  77777b  *  shift  1  bit  riaht 

*  a  mask  off  si an 

* - 

*  for  <  i  =  l »  i<=lmttabl )  i  =  i  +  l)  -C 

i  =  1 

idtmp  =  shif tl r ( cSid )  *  eliminate  si an  bit  for  comparison 

while<i  <=  lmttabl)  -C 

if  (idtmp  ==  shif t 1 r ( carStbl C i 3 > )  <. 
wahtcat  =  wahttblCi] 
return 

> 

if  (csid  <  carstblCi3) 
break 
i  =  i  +  1 

> 

wahtcat  =  ERR  #  carao  ID  not  found  in  table 
return 

*  - 

entry  Setidwc  #  input  weiahts  8  convert  to  wt*  codes 

rewind  NCGIDTS 

do  i  =  1,  CRGTBLSIZ 

•C 

read  (NCGIDTS*10)  carStbl C i 3  *  weiahtr  lonaltr 
if  (endfi le (NCGIDTS >  )  -C 
lmttabl  =  i  -  1 
if  (lmttabl  ==  0)  <. 

write  (NERRRPTi-40)  *  carao  id  file  is  null 

call  remark(,null  carao  id  file  detected  by  setidwc') 

wahtcat  =  ERR 

> 

write(NREP0RTr60>  (J>  wccount£J3f  J=1f6) 

wri te(NREP0RTf 61 >  wccount£73 

return 

> 

wahttblti3  =  wcatset(weisht*  lonaltr) 
if  (carstblCi]  <=  prvcaid)  <. 

write  ( NERRRPT » 20 )  caratbl£i3»  i 
wahtcat  =  ERR 
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return 

“V. 

J 

prvcsiid  =  carStblCiH 

> 

wri  te  <  NERRRPT  t 30 ) 

call  remark (' cardo/weidht  table  overflow  in  setidwc') 
wdhtcat  =  ERR 

10  format  ( a4 » lx  t  f  3 . 1  >  1>;  r  al  > 

20  format  ('  Ocardo  ident  '  *  a4  *  '  out  of  seouence—  ' » 

'table  element  no.  '»:i.4> 

30  format (' Ocardo  ident/weisht-code  table  overflow.') 

40  format( 'Ocardo  id  file  is  null.') 

60  format(/<'  count  for  weight  category  ' t rl r  ' - ' t i 4 ) ) 

61  f ormat < ' Ocount  of  undefined  weiShts=  '>i4) 


■*  * 
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Determine  weight  category  of  container  of  weight  WEIGHT 
(L.0NGLTR  ==  'l'  indicates  "long  container”). 


integer  function  wcatget ( weight ?  longltr) 

implicit  integer  (a-z) 
real  weight 

common  /wgtcom/  wecountC7T 
data  wccount  /7*0/ 


* 


wtlbs  =  weight  *  2000 


♦  convert  from  short  tons  to  pounds 


if  (longltr  ==  'l')  -C 
if  (wtlbs  <  43001) 
wcat  =  5 

else  if  (wtlbs  >  50000) 
wcat  =  6 
else 

wcat  -7  *  no 

>  else  -C 

if  (wtlbs  <  6801) 
wcat  =  1 

else  if  (wtlbs  >  10800  X  wtlbs  < 
wcat  =  2 

else  if  (wtlbs  >  19800  &  wtlbs  < 
wcat  =  3 

else  if  (wtlbs  >  43800  &  wtlbs  < 
wcat  =  4 
else 

wcat  =7  #  no 


recognizable  weight  category 


12801) 

23801) 

45801) 


recognizable  weight  category 


wcatset  =  shift ( 1 fwcat-l )  *  return  a  1-bit  mask 


wccountCwcat 1  =  wccountCwcat 1  +1  *  increment  appropriate  counter 
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f  convert  operator  ID  from  2-didit  number  to  3 
*  letter  code  in  the  rande  A  -  L 


r 

integer  function  cvopr id ( oper idt ) 

implicit  irrteder  (a-z) 
integer  opertblC123 

data  opertbl  /2r01»  2r02»  2r03>  2r04>  2r05f  2r06» 
2r07 ?  2r08>  2r09>  2rl0»  2rll,  2rl2/ 


if  (operidt  ==  2555b)  < 
cvoprid  =  UNDEF 
return 

> 


*  ( 2ru  ) 


do  i  =  1>  12 

-C 

if  (operidt  ==  opertblCiH)  ■£ 

cvoprid  =  i  #  l=lra*  2=lrb* 

return 

> 

> 

cvoprid  =  ERR 
return 
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♦  Determine  di rect ion-of -movement *  cycle  type*  end  dsch/recv  break 

I  code  for  indicated  discharger*  receiver*  facility  ID  combination 

*  - 

logical  function  clasify  (facilid*  dschxpt*  recvxpt*  *  input  psrsms. 

dirmvmt*  cyctape*  xptbrk)  *  output  params. 

implicit  integer  ( a-z ) 
common  /ncdrec/  ncdrec 


clasify  =  .true.  #  optimistic  default 

dirmvmt  =  cactype  =  xptbrk  =  UNDEF 

#  determine  fccode*  dxcode*  and  rxcode 


* 


if  <fcltype(facilid* 
write  ( NERRRPT * 2 ) 
go  to  90 

> 

if  (xpttype (dschxpt* 
write  ( NERRRPT  *  4 ) 
go  to  90 

> 

if  ( xpttype ( recvxpt * 
write  ( NERRRPT  *  6 ) 
go  to  90 

> 


fccode;  ==  ERR)  <  * 

facilid*  ncdrec  # 

dxcode )  ==  ERR)  <.  * 

dschxpt*  ncdrec  * 

rxcode)  ==  ERR)  <  * 

recvxpt*  ncdrec  * 


facility  type 
invalid  facility  code 


dsch.  xptr.  type 
invalid  DX  code 


recv.  xptr.  type 
invalid  RX  code 


if  (fccode  ==  LAN!  -C  ♦  some  inland  facility 

if  (dxcode  ==  LIGHTER)  <  #  cargo  discharged  by  lighter 

if  (rxcode  ==  STOR)  T  #  %  received  into  storage 

dirmvmt  =  OFFLOAD 
cactype  =  2 
xptbrk  *  DISCHARGE 

>  else  if  (rxcode  ==  LANDV)  -C  #  %  received  by  land  vehicle 

dirmvmt  =  OFFLOAD 
cyctape  =  1 
xptbrk  =  DISCHARGE 

>  else  -C 

write  (NERRRPT*8)  recvxpt*  ncdrec  #  invalid  receiver 

go  to  90 

> 

>  else  if  (dxcode  •==  STOR)  -C  #  cargo  removed  from  storage 

if  (rxcode  ==  LIGHTER)  < 
dirmvmt  =  RETR0GD 
cactype  =  3 
xptbrk  =  RECEIVE 

>  else  if  (rxcode  ==  STOR)  -C 

cyctape  =  4 

>  else  if  (rxcode  ==  LANDV)  -C 


0-17 
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dirmvmt  =  OFFLOAD 
c actype  =  3 

>  else  -C 

write  ( NERRRPT > 10 )  recvxptu  ncdrec  ♦  invalid  receiver 
so  to  90 

> 

>  else  if  (decode  ==  LANDV)  C  #  cardo  discharsed  by  land  vehicle 

if  <  rxcode  ==  LIGHTER)  < 
dirmvmt  =  RETROGD 
cyctype  =  1 
xptbrk  =  RECEIVE 

>  else  if  (rxcode  ==  STOR)  { 

dirmvmt  =  OFFLOAD 
cyctype  =  2 

>  else  -C 

write  (NERRRPT* 12)  recvxpt*  ncdrec  #  invalid  receiver 
So  to  90 

> 

>  else  -I 

write  ( NERRRPT » 14 >  dschxpt*  ncdrec  *  invalid  discharser 
So  to  90 

> 

> 

# - 

else  if  (fccode  ==  SEA)  -C  *  COD  or  TCDF 
if  ( dxcode  ==  LIGHTER)  < 
if  (rxcode  ==  STOR)  < 
dirmvmt  =  RETROGD 
cyctype  =  2 
xptbrk  =  DISCHARGE 

>  else  if  (rxcode  ==  NSSC)  <. 

dirmvmt  =  RFTR0GD 
cyctype  =  1 
xptbrk  =  DISCHARGE 

>  else  -C 

write  ( NERRRPT r 8)  recvxptf  ncdrec  #  invalid  receiver 
So  to  90 

> 

>  else  if  (dxcode  ==  STOR)  -C 
if  (rxcode  ==  LIGHTER)  { 
dirmvmt  =  OFFLOAD 
cyctype  =  3 
xptbrk  =  RECEIVE 

>  else  if  (rxcode  ==  STOR)  < 

cyctype  =  4 

>  else  if  (rxcode  ==  NSSC)  0 

dirmvmt  =  RETROGD 
cyctype  =  3 

>  else  { 

write  ( NERRRPT r 10 )  recvxpt*  ncdrec  *  invalid  receiver 


D- 18 
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So  to  90 

> 

>  else  if  (dxcode  ==  NSSC)  < 

if  < rxcode  ==  LIGHTER)  -C 
dirmvmt  =  OFFLOAD 
cyctype  =  1 
xptbrk  =  RECEIVE 

>  else  if  (recode  ==  STOR)  ■£ 

dirmvmt  =  OFFLOAD 
cyctype  =  2 

>  else  < 

write  (NERRRPTfl6)  recvxpt*  ncdrec  #  invalid  receaver 
do  to  90 

> 

>  else  -C 

write  <NERRRPT»14>  dschxpt*  ncdrec  *  invalid  discharger 
do  to  90 

> 

>  else  -C 

write  <NERRRPT>18)  facilidr  ncdrec 
90  clasify  *  .false. 

> 

* - 

2  format< 'Oinvalid  facility  code  'ra4t'  in  cardf  record  no.  '»i5> 

4  format < 'Oinvalid  dx  code  '»a4r'  in  cardf  record  no.  '»i5> 

6  format< 'Oinvalid  rx  code  '»a4f'  in  cardf  record  no.  '»i5> 

8  format< 'Oinvalid  receiver  code  '»a4r 

'  for  cardo  discharded  from  lidhter  in  cardf  record  no.  'r 

10  format ( 'Oinvalid  receiver  code  '»a4f 

'  for  cardo  discharded  from  storade  in  cardf  record  no.  ' r 

12  format< 'Oinvalid  receiver  code  '»a4» 

'  for  cardo  discharded  from  land  vehicle  in  cardf  record  no 
i5) 

14  format ( 'Oinvalid  discharder  code  '»a4r 

'  for  sea  facility  in  cardf  record  no.  'fi5> 

16  format ( 'Oinvalid  receiver  code  '»a4» 

'  for  cardo  discharded  from  nssc  in  cardf  record  no.  '»i5> 

18  format< 'Oinvalid  code  '»a4»'  returned  by  fcltype  in  record  no.  '? 
'  —  fatal  error?  execution  terminates' > 
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integer  function  fcltype  (fcname*  ft)  #  determine  facility  type 
implicit  integer  <a-z) 


if  (fcname  ==  'cod"  !  fcname  ==  'tcdf')  < 
fcltype  *  ft  *  SEA 
return 

> 

if  (fcnamess'adp7  !  fcname=='ecwy'  !  fcname==/bbcs/  !  f cname*** '  edp 7  >{ 
fcltype  =  ft  *  LAND 
return 

> 


fcltype  =  ft  =  ERR 
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integer  function  xpttape  (::ptname»  xt) 

♦  determine  type  of  transporter 

*  (STOPS’  NSSCr  LANDV »  or  LIGHTER) 

implicit  integer  < 3-2 > 


if  (xptname  ==  'stor')  < 


xpttape  » 

xt 

=  STOP 

> 

return 

if 

(xptname 

=  25 

'nssc' ) 

■C 

xpttape  = 

xt 

=  NSSC 

> 

return 

if 

(xptname  : 

ss 

'5mc'  ! 

xptname  ==  'Sat'  !  xptname  == 

' 5sSp ' ) 

xpttape  = 

xt 

a  LANDU 

> 

return 

if 

(xptname 

as 

'  lcm8' 

!  xptname  ==  'leu'  i  xptname 

==  'laev 

•  xptname 

as 

' lcl5' 

!  xptname  ==  'sbbg'  !  xptname 

==  ' lc60 

'  xptname 

as 

'cf ra' 

!  xptname  »*  'lshb')  -C 

xpttape  *  xt  *  LIGHTER 
return 


xpttape  *  xt  *  ERR 
return 
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overlay<  'cyclovr'  *2*0) 

program  crscint  *  create  selection  criteria  intermediate  file 

implicit  integer  (a-z) 

logical  endfile*  wgtmskr*  bgtblok 

integer  wcC63*  titleC43 

integer  selcritC123 

integer  scnameC2* 123 

integer  bygentb*  atlimitC63*  attrtbl£L13* 63 


real  bktsize 
integer  auxinfoC83 

* 

MUST  BE  8  WORDS 

eoui valence  (auxinfoC13*nbucket > * 

* 

add'l.  info,  to  be 

written 

(auxinfoC23 »bktsize) * 
(auxinfoC33»prthist> » 

* 

to  SCINTR  file 

(auxinfoC43*nscrec) * 
(auxinfoC53 * title) 

* 

N.B.  TITLE  is  four 

(4)  words 

#  Each  element  of  the  ATLIMIT  array  indicates  the  number 

#  of  elements  in  the  corresponding  row  of  the  ATTRTBL  array. 


data  atlimit 


At 

13, 

At 

7 


#  attribute-table  limits  (for  ’BY^-codes) 

#  direction-of-movement 

#  cycle  interruption 

#  sling/lifting  device 

#  operator  ID 

#  cycle  type 

/  #  weight  category 


The  ATTRTBL  array  defines  the  legitimate  values  for 
those  selection  criteria  categories  which  can  be  selected  to 
automatically  range  through  their  values  (known  as  the  ■BY* 
feature  in  System  2000). 


data  (attrtblCi*13*i=l*2) 
(attrtbl Ci *23 > i=l *2) 
(attrtblCi *33  * i=l *4) 
(attrtblCi ,43  * i=l » 13) 

(attrtblCi *53  * i=l *4) 
(attrtblCi *63 * i=l *7) 

* - 

•  Text  to  identify  category  in 


/OFFLOAD*  RETR0GD/* 

/INTER*  UNINTER/* 

/'hosa ' * 'manl '*'sling'*'u'/* 
/I *2*3*4*5*6*7*8*9*10* 11 *12* 
UNDEF/* 

/It  2*  3*  A/t 

/ lb  *  2b  *  4b  *  1 0b  *  20b  *  40b  *  100b/ 


error  messages 


data  (scnameCi*13  *i=l*2) 
(scnameCi*23  *i=l»2) 
(scnameCi*33  *i=l*2) 
(scnameCi *43  *i“l»2) 
(scnameCi*53  *i»l*2) 
(scnameCi *63  *i=l*2) 


/'movement  direction'/* 

/'cycle  interruption'/* 

/'sling/lifting  device'/* 

/'operator  identifier'/* 

/'cycle  type  '/*  *  needs  trlng.  blank 

/'weight  category'/* 
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(scnameCi?73  ?i=l?2> 
(scnameCi ?83  ?i=l?2) 
(scnameCi?93  ?i=l?2) 
(scnameCi ? 103?i=l ?2> 
(scnameCi ?113?i=l?2) 
(scnameCi ?123?i=l?2) 


/'lighter  sequence'/? 
/'special  transporter '/ ? 
/'cycle  start  lower'/? 
/'cycle  start  upper'/? 
/'cycle  duration  lower'/? 
/'cycle  duration  upper'/ 


rewind  NSCFILE  *  prepare  to  input  user's  selection  criteria 

rewind  NSCINTR 
whileC .  true. )  -C 

read(NSCFILE?80)  dm?  ci?  si?  oi?  ct?  wc?  Is?  sx?  csl?  csu? 

cdl?  cdu?  nbucket?  bktsize?  prthist? 
title?  nscrec 
if  (endf ile(NSCFILE) )  -C 
rewind  NSCINTR 
return 

> 

write  <NREP0RT?85)  dm?  ci?  si?  oi?  ct?  wc?  Is?  sx?  csl?  csu? 

cdl?  cdu?  nbucket?  bktsize?  prthist? 
title?  nscrec 

call  bcreset  #  initialize  for  a  new  set  of  BY  codes 

if  (bycode(dm?  1?  bcstat)  =-  NO)  <  #  direct ion-of-movement 

if  (dm  ==  BLANK) 
selcritC13  *  ANY 
else  if  (da  ==  lro) 

selcritC13  *  OFFLOAD 
else  if  (dm  ==  lrr) 

selcritC13  *  RETROGD 
else  -C 

write  (NERRRPT?2)  (scnameCi ? 13 ? i=l ?2) ?  nscrec 
next 

> 

>  else  if  (bcstat  ==  ERR)  < 

write  (NERRRPT?4)  (scnameCi ? 13 ? i=l ?2) ?  nscrec 
next 

> 

if  (bycode(ci?  2?  bcstat)  ==  NO)  <  #  cycle  interruption  code 

if  (ci  —  BLANK) 
selcritC23  =  ANY 
else  if  (ci  ==  Iru) 

selcritC23  *  UNINTER 
else  if  (ci  *=  lri) 
selcritC23  =  INTER 
else  < 

write  (NERRRPT?2)  (scnameCi ?23? i=l ?2) ?  nscrec 
next 

> 

>  else  if  (bcstat  =»  ERR)  -C 


sx?  csl? 
prthist? 


csu? 


.V> 


D-23 


10/23/78 


09.25.56. 


CRSCINT 


PAGE  NO 


123456789 

write  (NERRRPT?4>  (scnameCi »2D r i  =  l >2) t  nscree 
next 


if  (bycode(slr  3»  bcstat)  ==  NO)  -C  #  si ind/1 if tins  device 
if  <sl  ==  BLANK) 
selcri tC3D  =  ANY 
else  if  (si  ==  lrh) 
selcritC31  =  'hosa' 
else  if  (si  ==  lrm) 
selcritC3D  =  'manl' 
else  if  (si  =-  lru) 
selcritC33  =  'u' 
else  -C 

write  (NERRRPT»2)  (scn3meCi»3D»i=l»2) »  nscrec 
next 

> 

>  else  if  (bcstat  ==  ERR)  -C 

write  (NERRRPT»4)  (scnameCi »31 * i=l t 2) r  nscrec 


if  (bycode(oi »  4»  bcstat)  ==  NO)  <  #  operator  ID 

if  (oi  —  BLANK) 
selcritC43  *  ANY 
else  < 

if  (oi  >  lrl)  -C  #  valid  ID'S  are  A-L 

write  (NERRRPT »2>  (scnameCi r43 1 i=l »2> t  nscrec 
next 

> 

selcritC4]  *  oi 

> 

>  else  if  (bcstat  ==  ERR)  < 

write  (NERRRPT»4)  ( scnameCi r 43 » i«l >2) r  nscrec 


if  (bwcode(ctr  5»  bcstat)  =*=  NO)  -C  *  cycle  type 
if  (ct  ■■  BLANK) 
selcritC51  =  ANY 
else  < 

if  (ct  >  lrd)  <  ♦  valid  codes  are  A 

write  (NERRRPT»4)  (scnameCi  »53 r  i=>l  r2)  r  nscrec 
next 

> 

selcritC53  =>  ct 

> 

>  else  if  (bcstat  ■«  ERR)  < 

write  (NERRRPT»2)  (scnameCi f 81 » i«l >2) *  nscrec 


next 


D-24 


if  (bycode(wcC13r  6*  bcstat)  ==  NO)  <  *  weiaht  category 
if  (wcC13  «  BLANK) 
selcri tC61  =  ANY 
else 

if  (wgtmskr(wc»  selcritC63))  *  create  weight  category  mask 
continue  ♦  if  wc  contains  valid  code(s) 

else  -C 

write  (NERRRPT»2)  (scnameCi * i  =  l r2) r  nscrec 
next 

> 

>  else  if  (bcstat  ==  ERR)  < 

write  (NERRRPT>4)  (scnameCi »63 t i=l »2) »  nscrec 
next 


if  (Is  ==  lrb)  #  lighter 

selcritC73  =  BETWEEN 
else  if  (Is  ==  lrw) 
selcritC73  =  WITHIN 
else  if  (Is  «  BLANK) 
selcritC73  =  ANY 

else  if  (Is  >=  lrl  8  Is  <=  lr9>  #  single 

selcritC73  =  Is  -  IrO  #  part 

else  -C 

write  (NERRRPT»2)  (scnameCi »73 r i»l »2) r  nscrec 


*  lighter  seauence  code 


#  single  digit  specifies 

#  particular  ltr.  cycle 


if  (sx  ==  BLANK)  #  special 

selcritC83  *  ANY 
else  if  (sx  “=  lrl) 
selcritC83  *  LSHB 
else  if  (sx  =<*  lrs) 
selcri tC81  =  SBBG 
else  if  (sx  ==  lrx) 

selcritC83  ■  EXCLUDE 
else  < 

write  (NERRRPT*2>  (scnameCi »83 » i=l » 2) r  nscrec 


#  special  transporter 


if  (csl  ■*  0) 

selcritC93  »  UNDEF 
else 

selcritC93  »  minutes (csl) 


*  cycle  start  lower-limit 


if  (csu  »■  0) 

selcritClOD  «  UNDEF 


#  cycle  start  upper-limit 


wmsm 


0-25 


10/23/78 

09.25. 

56. 

CRSCINT 

PAGE  NO 

12  3 

4  5  6 

7 

8  9 

else 

selcritC103 

minutes (csu) 

# 

if  <cdl  ==  0)  *  cycle  duration  lower-limit 

selcritC113  =  UNDEF 
else 

selcritC113  =  minutes(cdl) 

* - 

if  (cdu  -***'  0)  *  cycle  duration  upper-limit 

selcritC123  =  UNDEF 
else 

selcritC123  =  minutes(cdu) 

t - 

#  IF  BY-code  table  is  properly  set  upf  generate  individual  SC 

#  records  for  each  item  selected  for  BY-explosion.  See  also  BYCODE 

#  for  a  better  understanding  of  the  BY-seneration  table* 

#  - 

if  (bdtbl  ok  (dummy  > )  -C 

if  (bygentbC13  **  0)  -C  #  perform  BY  code  "explosion* 

bll  =  atlimitCbygentbCIDD 
do  bl  *  It  bll 

selcritCbwgentbC133  -  attrtblCbl  FbwgentbC133 
if  (bygentbC23  0)  < 

b21  *  atlimitCbygentbC233 
do  b2  *  1»  b21 
-C 

selcritCbySentbC233  =  attrtblCb2f bygentbC233 
if  <bygentbC33  ~=  0)  < 

b31  =  atlimitCbygentbC333 
do  b3  *  If  b31 
< 

selcritCbygentbC333  =  attrtblCb3rbygentbC333 
if  <bygentbC43  "=  0)  -C 

b41  =  atlimitCbygentbC433 
do  54  »  If  b41 
■C 

selcritCbygentbC433  =  attrtblCb4FbygentbC433 
if  <bygentbC53  "=  0)  -C 

b51  =  atlimitCbygentbC533 
do  b5  -  If  b51 
•C 

selcritCbygentbC533  =  attrtblCb5FbygentbC533 
if  <bygentbC63  *=  0)  < 

b61  *  atl imit CbygentbC63 3 
do  b6  >  If  b61 

write  (NSCINTR)  selcritF  auxinfo 
selcritCbygentbC633  =  attrtblCb6FbygentbC633 
>  else 
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write  (NSCINTR)  selcritf  auxinfo 

> 

>  else 

write  (NSCINTR)  selcritf  auxinfo 

> 

>  else 

write  (NSCINTR)  selcritf  auxinfo 

> 

>  else 

write  (NSCINTR)  selcritf  auxinfo 

> 

>  else 

write  (NSCINTR)  selcritf  auxinfo 

> 

>  else 

write  (NSCINTR)  selcritf  auxinfo 
>  else 

write  (NERRRPT f 90)  nscrec  #  error  in  BY-code  specification 
>  ♦  end  of  "repeat" 


2 

format ( 70error  in 

selection  code 

for  category  7f2al0f 

7  in  record 

no.  7fi6) 

4 

format( 'Oerror  in 

by  code  for 

selection  of  /f2al0f 

7  in  record 

no.  7»i6) 

80 

format(5( rl t lx) » 

* 

dmr  cif  slf  oif  ct 

6rl f lxf 

* 

wc 

2(rlf lx) f 

* 

lSf  sx 

4i4f 

# 

cslf  csuf  cdlf  cdu 

i3f lxf 

* 

nbucket 

f6.2r lx» 

* 

bktsize 

rl ? lxr 

* 

prthist 

4al0f 

* 

title 

i6  ) 

* 

nscrec 

85 

format(/7  selection  record — 

7 » 

5( rl t lx) f 

#  dntf  cif  slf  oif  ct 

6rlf lxf 

* 

wc 

2( rl f lx) ? 

* 

lSf  sx 

4 ( i4» lx) f 

* 

cslf  csuf  cdlf  cdu 

i3f Ixf 

* 

nbucket 

f6.2» lx» 

* 

bktsize 

rl f Ixf 

* 

prthist 

4al0f 

* 

title 

16  ) 

* 

nscrec 

90 

format ( 'Oerror  in 

by-code  specification  in  sc  record  no 
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intesier 
integer 
hours  = 
minutes 


4  5  6  7  8  9 

function  minutes  <hhmm)  #  convert  hrs./mins.  code  to  minutes 

hours f  hhmm 
hhmm/100 

=  hours  *  60  +  hhmm  -  hours  *  100 
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#  Test  SCFIELD  for  being  3  'BY*  code  S  set  up  BY-generation  table 

#  - 

#  If  the  code  passed  as  the  value  of  the  SCFIELD  parameter  is 

#  in  the  range  of  valid  BY~codes?  and  this  code  has  not  already  been 

#  specified  on  the  same  selection  criteria  record  (since  the  last 

#  time  BCRESET  was  called)?  save  the  value  of  the  SCNUM  parameter  in 

#  the  element  of  the  BYGENTB  arras  specified  by  SCFIELD  and  return 

#  YES  as  the  function  value?  as  well  as  through  the  RETCODE  parameter 

# 

#  The  BY-seneration  table  will  be  used  by  the  routi  CRSCINT 

#  (which  is  the  sole  caller  of  BYCODE)  to  perform  the  lection 

#  criteria  'explosion*  function  (generation  of  multipl  >'C  records 

#  for  records  from  SCFILE  specifying  *BY*  selections*) 

#  -  - 

integer  function  bycode  (scfield?  scnum?  retcode) 

implicit  integer  (a-z) 
common  /bgt/  bygentbC63 


* 


if  (scfield  >  IrO  %  scfield  <=  lr6)  <  #  if  valid  BY  ordering  num* 
bynum  »  scfield  -  IrO  #  (convert  to  integer) 

if  (bygentbCbsnumT  ==  0)  -C  #  and  num.  not  previously  used 

bygentbCbynumT  =  scnum  #  set  proper  element  of  BY-generation 
bycode  *  retcode  =  YES  #  table  to  sel*  crit.  category  number 
>  else 

bycode  =»  retcode  =  ERR  #  user  selected  same  BY  number 

#  more  than  once 


>  else 

bycode  *  retcode  =  NO 


♦  not  a  valid  BY  code 


return 
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♦  See  if  BY-generat ion  table  is  set  up  properly 

♦  - 

logical  function  bgtblok  (dummy) 

implicit  integer  (a-z) 

logical  zrfound  #  zero-element-found  flag 

common  /bgt/  bygentbC6! 


if  (bygentbCll  ==  0)  -C 

♦ 

if  1st  element  is 

zero  r 

do  i  = 
/ 

2f  6 

♦ 

check  that  all 

others  are  also 

i 

if 

(bygentbCil  M-  0) 

■C 

bgtblok  =  .false. 

♦ 

ERROR — some  element  is  non-zero 

> 

return 

> 

bgtblok  «  .true. 

♦ 

all  elements  are 

zero 

>  else  < 

zrfound  =  .false. 

do  i= 

r 

If  6 

* 

search  for  a  zero 

element 

if 

(zrfound)  -C 

if  (bygentbCil  M- 

0) 

< 

bgtblok  =  .false. 

return 

> 

>  else 

if  (bygentbCil  ==  0) 
zrfound  =  .true. 

> 


bgtblok  =  .true* 


♦all  non-zero  elements  are  compact 
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♦  create  weight  mask  from  individual  category  selection  codes 

#  - 

logical  function  wgtmskr  (wStcode»  rtnmask) 
implicit  integer  (a-z) 
integer  wStcodeC6] 


Accepts  6-element  array  of  risht-Justif ied  Hollerith- 
encoded  characters.  For  each  character  in  the  range 
A-F»  sets  appropriate  bit  in  RTNMASK. 

( A=  bit  Of  B=  bit  If  ...»  F=  bit  5) 

For  letter  *N*»  set  bit  7. 

(used  to  indicate  selection  of  all  cycles  for  containers 
with  no  weight  code) 


N.B.  If  any  of  the  following  code  looks  obscure»  here's  a  hint — 

Ira  =  1  ( rt. -Justified  letter  =  decimal  integer) 

lrb  =  2 


lrz  -  26 


bitter(nbit)  =  shift < 1 »nbit-l )  #  (statement  function) 

wgtmskr  ■  .true, 
rtnmask  =  0 


#  , 


for  (i=l»  i<=6»  i=i  +  l)  -C 
i  =  1 

while  (i  <=  6)  < 

if  (wgtcodeCiH  <=  lrf) 
rtnmask  =  rtnmask  ! 
else  if  (wgtcodeCiD  == 
rtnmask  =  rtnmask  ! 
i  -  i  +  1 


> 


#  select  wt.  category  A-F 
bitter(wgtcodeCiD ) 

lrn)  *  select  records  with  no  wt.  code 
100b 


if  (rtnmask  ==  0) 
wgtmskr  -  .false. 


#  if  no  bits  were  set» 

#  no  valid  codes  were  selected 
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overl3«< 'caclovr' *3*0) 

program  reportr  #  supervise  Sen.  of  cycle  data  statistics  report 


For  each  "group*  within  the  DBINTR  file*  range  through  each 
set  of  selection  criteria  contained  in  the  SCINTR  file*  selecting 
records  within  that  group  whose  attributes  cause  them  to  Qualify* 
saving  the  cycle  times  associated  with  this  set*  and  passing  them 
to  WRITRPT*  along  with  appropriate  information  needed  in  order  to 
produce  a  report  containing  statistics  for  the  particular  set  of 
records  selected. 

After  all  sets  of  selection  criteria  have  been  applied  to  a 
particular  group*  call  FACSUM  to  produce  a  summary  report 
containing  statistics  which  apply  to  the  group  as  a  whole 
(i.e.*  the  set  of  all  selected  sets). 


implicit  integer  <a-z) 

logical  tblmakr*  getslcr*  select 


integer  selcritCNSCl  # 
integer  scwordsCNSCWl  # 
integer  brkkeysC33  * 
integer  titleC4D  # 
integer  rctimesCMAXCYCLEl  * 
integer  ncyretr  * 
integer  bktsize  # 


SC  codes  for  SELECT 
Hollerith  codes  for  WRITRPT 
break  keys  for  WRITRPT 
report  heading 
retrieved  cycle  times 
no.  of  cycle  times  retrieved 
size  of  each  histogram  'bucket* 


call  sswtch< 1 *swl )  t 

call  sswtch(2»sw2)  # 

while  <  tblmakr  (brkkeysCl l ) )  -C  # 

* 

t 


dump  facility  table  to  NERRRPT 
produce  statistics  report 

create  cycle/attribute  table 
for  next  facility  group 
if  another  group  exists 


if  <sw2  ==  1) 

call  tbldmpr(brkkeysC13 > 


#  if  option  selected* 

#  dump  facility  table 


while  (getslcr(selcrit»  * 

title*  bktsize*  # 

nbucket*  prthist))  < 


for  next  set  of  selection  criteria 
<if  one  exists)* 


while  (select(selcrit*  *  return  indices  of  facility  table 

retimes*  ncyretr*  #  cycles  satisfying  these  criteria 

brkkeysC23*  brkkeysC33 ) )  -C  #  (while  cycle  groups  remain) 


call  mkscwrd( selcrit *  sewords)  *  gen*  SC  titles 
if  (ncyretr  >  0)  -C 

************************************************** 

#  replace  facility  table  indices  from  GETSLCR  * 

*  with  cycle  times  in  RCTIMES  array  and  * 


0-32 
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#  print  selected  Carso  Cycle  Data  * 

*  if  switch  3  is  set.  # 

************************************************** 

call  cvtpccd< retimes *  ncaretrn  title*  sewords* 
brkkeys*  prthist*  bktsize*  nbucket) 

if  (swl  ==  1) 

call  writrpt( retimes*  ncyretr*  title*  sewords* 
brkkeys*  prthist*  bktsize*  nbucket) 

> 

> 

if  (swl  ==  1 )  #  produce  summary  report 

#  for  entire  facility 
call  facsum( retimes »ncyretr»title»scwords* 

brkkeys  *  prthist  *  bktsize  *  nbucket ) 
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logical  function  tblmakr  (facname)  *  construct  facility  table 

implicit  integer  (a-z) 

logical  fstcall*  eofflag*  endfile 

common  dsilast* 

opdateCNFTSEGl >  opshf tCNFTSEGH »  f tbindxCNFTSEG] * 
dirmvmtCFTSIZED*  cytypeCFTSIZEH *  sglfdevCFTSIZEl » 
OPeridCFTSIZEII  *  wghtcatCFTSIZEl  *  cystartCFTSIZE3 » 
c«duratCFTSIZE3»  spclxptCFTSIZEH *  lgtrseoCFTSIZED * 
cyinterCFTSIZEl 
integer  paddinglZ63 

data  fstcall  /.true./*  eofflag/. false. /»  padding/6#0/ 


if  (eofflag)  *C  #  if  EOF  on  DBINTR  on  previous 

tblmakr  =  .false.  #  entry*  return  EOF  signal 

return 

> 

* - 

if  (fstcall)  <  *  read  file  header  on  first  call 

rewind  NDBINTR 

read  (NDBINTR)  filname*  dbname*  fcdate*  fctime*  dbdater  dbtime 
if  (endf ile(NDBINTR) )  < 

write  (NERRRPT*10)  #  d.  b.  intermediate  file  is  null 

call  remark('null  db  intermediate  file') 

stop 

> 

if  (filname  'dbintr')  -C 

write  (NERRRPT*20)  filname  #  wrong  file  used 

call  remark( 'wrong  file  on  unit  NDBINTR  detected  by  tblmakr') 

stop 

> 

write  (NREP0RT*5)  fcdate*  fctime*  dbdater  dbtime*  dbname 
fstcall  =  .false. 

> 

# - 

•  read  first  group  header 

*  (directly  into  0PDATE/0PSHFT  arrays) 
read  (NDBINTR)  bogflag*  facname*  opdateC13*  opshftC13*  padding 

if  (bogflag  BOG)  < 
write  (NERRRPT *30) 

call  remark( 'header  error  in  db  intermediate  file') 

stop 

> 

« - 

ftbindxC13  *  1  #  set  pointer  to  first  table  segment 

ftx  *  1  *  initialize  facility  table  index 

ptx  ■  2  *  and  pointer  array  index 
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read  (NDB1NTR)  wl*  w2 1  w3 r  w4>  w5*  w6f  w7r  w8r  w9r  wlO 
while  ("endfileeNDBINTR) )  -C 


*  NEW  GROUP  HEADER  PROCESSING 

*  enter  opn*  date  X  shift  code 

*  into  index  arrays 

*  set  index  pointer 

*  to  next  available  position 

*  if  new  sfroup  is  for  new  facility* 

*  reread  header  on  next  entry 

*  set  pointer  to  end  of  index  list 


dirmvmtCftxl 

=  wi; 

wdhtcatCftxl 

in 

3 

H 

spclxptCftxH 

a  W8 

cytypeCftx] 

=  w2 * 

cystartCftxD 

=  w6» 

ldtrseoCf txU 

=  w9 

operidCftx3 

=  w3» 

cyduratCftx3 

*  w7» 

cyinterCftxD 

=  WlO 

if  <wl  ==  BOG)  * 
opdateCptxl  =  w3 
opshftcptxj  =  w4 
ftbindxEptxl  =  ftx 
ptx  =  ptx  +  1 

if  (w2  M=  facname)  < 
backspace  NDBINTR 
tblmakr  =  *true* 
dsilast  =  ptx  -  1 
return 

> 

> 

else  {  #  not  new  droup  hdr — save  record  info  into  facility  table 
if  <ftx  >  FTSIZE)  -C 

call  remark ( 'facility  table  overflow  in  tblmakr' ) 

write  (NERRRPT *40) 

stop 


sdlfdevCftx3  *  w4 
ftx  *  ftx  +  1 

> 

read  (NDBINTR)  wl*  w2»  w3*  w4 *  w5»  w6r  w7*  wS»  w9*  wlO 

ftx 


ftbindxCptxl 
dsilast  *  ptx 
eofflad  =  tblmakr  =  .true, 
return 


♦END-OF-FILE  processind 

♦  set  last  index  pointer  to  end 

#  of  final  table  sedment  +  1 


5  formate 'Ousind  lots  intermediate  data  file  created  on'»a9* 
'  at'*a9*'  from  raw  data  file  of'*a9*'  — '*39* 

/'  raw  data  file  name  is  '»alO) 

10  format( 'Odata  base  intermediate  file  is  null.') 

20  formate 'Owrona  file  read  on  un*t  NDBINTR — '* 

'file  name  is  '*a6) 

30  formate 'Otblmakr  detected  unreadable  droup  header') 


D-35 
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40  form3t( 'Ofacilita  table  overflow — current,  limit  is  FTSIZE') 
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subroutine  tbldmpr  (facname)  #  dump  facility  table 


implicit  integer  <a-z) 
common  dsilast* 

OPdateCNFTSEGl*  opshf tCNFTSEGD *  f  tbindxCNFTSEG!] » 
dirmvmtCFTSIZEH »  cytypeCFTSIZE3 *  sslf devCFTSIZEU * 
OPeridCFTSIZED  *  wShtcatCFTSIZEU *  castartCFTSIZEl * 
cyduratCFTSIZED *  sPclxptCFTSIZEH *  1st rseaCFTSIZEH * 
cainterCFTSIZED 


* 


write  (NERRRPT *10) 
i  -  1 

while  (i  <  dsilast)  < 

write  eNERRRPT*20)  facname*  opdateCil*  opshftCiH 

J  *  ftbindxCi3 

last  -  ftbindxCi-Hl  -  1 

while  <J  <=  last)  -C 

wtcodes  3  wcident < wdhtcatC J3 ) 
write  ( NERRRPT » 30)  J* 

dirmvmtCJ3*  cyinterIZ  J1  *  sglf devC J1 *  operidCJl 
cytypeCJH*  wtcodes*  lstrseaC JD *  spclxptC J] * 
cystartCJUf  caduratCJH 

J  =  J  +  1 

> 

i  -  i  +  1 

> 


10  formate//lx*46e )  * '  facility  table  dump  ' * 46< )///) 

20  formate/'  facility  date  shift'/lx*3al0/6x* 

*  movement ' 3x ' interrupt ' 2x ' s 1 / 1 f  dev ' 2x ' ope rato  r  ' 3x  * 
'cycle  type' lx' weight  cat'lx'ltr  seo'4x'spcl  xpt'3x* 
' eye lesta rt ' lx ' eye ledurat ' / > 


formate  lx* i4* 

* 

cycle  number 

lx*alO* 

♦ 

di rect ion-of-movement 

lx*alO* 

* 

cycle  interruption 

lxralO* 

* 

s/1  device 

lx* ilO* 

* 

operator  ID 

lXfilO* 

* 

cycle  type 

lx*alO* 

* 

weight  category 

lx*ilO* 

* 

lighter  seauence 

lx  *  alO  * 

• 

special  transporter 

2eix*il0)) 

* 

cystart*  cydurat 
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#  Get  selection  criteria  from  intermediate  file  created  by  CRSCINT 

#  returns  .FALSE,  on  EOF *  .TRUE,  otherwise 

#  - 

logical  function  getslcr  (selcrit*  title*  bktsize*  nbucket*  prthist) 


implicit  integer  (a-z) 
integer  selcritC123 *  titleC4] 
logical  endfile 
common  /nscrec/  nscrec 
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I 


£ 
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t 


g 


if 


* 

* 

* 

* 

# 

* 

# 

* 

* 

* 


12345478? 


Select  and  return  a  set  of  cycle  times 


Scan  current  facility  table  <most  recently  constructed  by 
TBLMAKR)  for  those  cycles  which  satisfy  the  criteria  given  in 
the  SC  array  passed  by  the  caller.  Return  the  cycle  times  indices 
fro*  all  such  cycles  in  the  CYCLES  array  (through  the  formal 
parameter  list)?  and  set  the  FP  NCYCLES  to  the  value  of  the 
number  of  cycles  being  returned. 


Set  the  variables  SDATE  and  SSH1FT  to  indicate  the  date  and 
shift  of  the  operation  from  which  the  cycles  were  obtained. 


logical  function  select(sc?  cycles?  ncycles?  sdate?  sshift) 


integer 

integer 

integer 

integer 

integer 


* 

* 

* 

# 

* 

* 


selection  criteria  array 

cycle  times  returned  to  caller 

no.  of  cycles  being  returned 

selected  group  date 

selected  group  shift 

index  for  date/shift/pointer  table 


implicit  integer  (a-z) 
integer  scC123 

cyclesCMAXCYCLED 
ncycles 
sdate 
sshift 
dsindex 
common  /nscrec/  nscrec 
common  dsilast? 

opdateCNFTSEGD t  opshif tCNFTSEG3 ?  f tbindxCNFTSEGT ? 
di rmvat CFTSIZE3 ?  cytypeCFTSIZE3 ?  sglfdevCFTSIZE] ? 
operidCFTSIZE3?  wghtcatCFTSIZE3 ?  cystartCFTSIZE3 ? 
cydurat CFTSIZE3 ?  SPClxptCFTSIZEU ?  lStrseoCFTSIZE] ? 
cy inter CFTSIZE3 

data  dsindex/0/  #  ***  FOR  FIRST  CALL  ONLY  *** 


ncycles 

dsindex 

sdate  * 

sshift  ’ 


■  0 

*  dsindex  +  1 
OPdateCdsindexD 
>  opshif tCdsindex] 


if 


>»  dsilast) 
.false. 

>  0 


(dsindex 
select  * 
dsindex 
return 

> 

for  < i*ftbindxC dsindex 3 \ 
i  *  ftbindxCdsindex3 
whiled  <  f tbindxCdsindex+1 3 ) 


initialize  cycle  counter 
and  pointer  table  index 
return  selected  group  date 
and  shift 

check  for  end  of  current  data  table 


•  re-initial ize  pointer  for  next  call 


i<ftbindxCdsindex+ 13  *  i»i+l>  -C 


if  (ncycles  >-  MAXCYCLE)  -C 

write (NERRRPT? 10)  sdate?  sshift?  nscrec 
call  remark(/too  many  cycles  selected') 

stop 


if  (dirmvmtCi3 
if  <cyinterCi3 


scC13 

scC23 


scC13  «  ANY) 
scC23  —  ANY) 
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if 

if 

if 

if 

if 


<sdlfdevCi3  ==  scC33  !  scC33  ==  ANY) 
<operidCi3  «  scC43  !  scC43  ==  ANY) 
<cytypeCi3  ==  scC53  scC53  ==  ANY) 

( ( wdhtcatCil  X  scC43)  "=  0  !  scC43  == 
<<scC73  ==  ANY) 

!(scC73  ==  BETWEEN  X  ldtrseaCil  ==  0) 
l<scC73  ==  WITHIN  X  ldtrseoCil  ~=  0) 

5  <scC73  >=  0  X  ldtrseaCil  ==  scC73)) 


ANY)  #  test  wt*-code 

#  s 1 1  cycles 

#  inter-cade 

#  intra-cycle 

#  specific  cycle 


bit 


if  <<scC83  ==  ANY) 

* (scC83  ==  LSHB  X  spclxptCil  ==  LSHB) 

! (scC83  ==  SBBG  X  spclxptCil  ==  SBBG) 

! (scC83  ==  EXCLUDE  X  spclxptCil  ~=  LSHB 

X  spclxptCiD  SBBG)) 


#  all  transporters 

#  lash  barde 

4  seabee  barde 

#  neither  lash 

t  nor  seabee  barde 


if  <<scC93==UNDEF  !  cystartCi3>=scC93 ) 

X  <scC103==UNDEF  !  cystartCi3<=scC103) ) 


*  cycle  start  time 

#  must  be  within 


if  < <scC113*=UNDEF  !  cyduratCi3>=scC113 )  # 

X  ( scC 123a-UNDEF  S  cyduratCi3<=scC123 ) )  -C  * 


limits  unless 
limits  not  diven 


ncycles  =  ncycles  +  1 

cyclesCncycles3  =  i  #  return  cycle  index 

> 

i  -  i  +  1 

> 

select  »  .true*  *  not  yet  end  of  SC  data 


10  format < 7 Ocwcle  overflow  in  selection  for  date  7»a3» 

7  shift  7»al/7  current  size  of  cycle  table  is  MAXCYCLE'r 
7  selection  criteria  record  no*  7»i4) 
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♦  Fabricate  selection  criteria  title  words  for  WRITRPT. 

*  - 

subroutine  mkscwrd  (sccode*  scword) 

implicit  integer  (a-z) 

integer  sccodeCNSCH *  scwordCNSCWl *  tempC4] 


scwordClD  =  sccodeClJ 
scwordC23  =  sccodeC2H 
scwordC3]  =  sccodeC31 


#  di r-of-mvmt 

#  cycle  interruption 

#  sling/lift  device 


if  (sccodeC43  >=  Ira  &  sccodeC43  <=  lrl)  #  operator  ID 
encode  (8*  15r  scwordC4U)  sccodeC4D 
else 

scwordC4H  =  sccodeC43 


if  (sccodeC53  >»  Ira  £  sccodeC53  <=  lrd)  #  cycle  type 
encode  (10*  40*  scwordCSD)  sccodeCSH 
else 

scwordC5]  =  sccodeCSU 


if  (sccodeC6H  =**  any) 
scwordC63  =  ANY 
else 

scwordC63  =  wcident <sccodeC63 > 


if  (sccodeC7j  >=  1  l  sccodeC73  <=  9) 
encode  (10*  10*  scwordC73)  sccodeC7D 

else 

scwordC71  »  sccodeC73 


#  wt*  category 


#  lighter  sequence 


scwordL83  *  sccodeCBI 


i»  1*  4 

if  (sccodeCi+83  —  UNDEF) 
tempCiD  =  '♦♦♦♦' 
else 

encode  (4*  20*  tempCi])  sccodeCi+8D 


encode  (10*  30*  scwordC?])  tempEl!]*  tempt 23 
encode  (10*  30*  scwordC103)  tempC33»  temp C 4 I 


#  special  xporter 


#  cycle  start/dur 
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#  Encode  a  10-character  word  with  a  printable  weisiht  code 

#  designator*  based  on  bits  set  in  input  parameter  value  WTCODE 


if  <and<shift(wtcode*  l-i>*  1>  "=  0) 

codes C ill  *  i  #  cf*  'N^B**  comment  in  WGTMSKR 

else 

codes Cil  =  BLANK 

if  ( and ( shift (wtcode*  -6)»  1)  *=  0) 
codesC7D  *  lrn 
else 

codesC71  =  BLANK 
encode  <10*  10*  wcident)  codes 


10  format('wt 


i 
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#  Convert  cycles  and  Print  selected  Cargo  Cycle  Data* 


1)  Convert  values  in  RCTIMES  array  from  indices  of  selected 
facility  table  elements  to  values  of  cycle  times  for  those  indices 

2)  If  option  selected  by  setting  of  sense  switch  3*  print 
•exploded*  selection  criteria  values  from  SCWORDS*  and 
print  values  of  facility  table  cycle  data  actually  selected* 


subroutine  cvtpccd  (retimes*  ncyretr*  title*  sewords* 

brkkeys*  prthist*  bktsize*  nbucket) 
implicit  integer  (a-z) 

integer  rctimesEncyretrl »  titleC43*  scwordsCNSCW3 >  brkkeysE3D 
common  dsilast* 

opdateCNFTSEGl*  opshf t CNFTSEG3 *  f tbindxCNFTSEG] * 
dirmvmtCFTSIZEl*  cytypeCFTSIZEl *  sdlf devCFTSIZEZI * 
operidCFTSIZEl *  wghtcatCFTSIZEH »  cystartCFTSIZED * 
cyduratCFTSIZE] *  spclxptCFTSIZEH *  lstrseaCFTSIZEl * 
cyinterCFTSIZEH 


call  sswtch( 3* switch)  *  print  table  info*  if  sw»  3  set 

if  (switch  ==  1 ) 

write  (NREPORT*  10)  title*  prthist*  bktsize*  nbucket*  sewords* 

brkkeys*  ncyretr 

if  (ncyretr  "=  0) 
do  i8  1*  ncyretr 


J  =  rctimesEil  *  replace  index  with  cycle  value 

rctimesCiD  *  cyduratCJl  #  for  routine  WRITRPT 
if  (switch  88  1)  < 

wtcodes  8  wcident( wShtcatC J3 ) 
write  (NREPORT *20)  J* 

dirmvmtCJD*  cyinterCJH*  sdlf devC J3 *  operidCJD* 
cwtypeCJl*  wtcodes*  lgtrseoC J3 *  spclxptCJII* 
cystartCJ]*  cyduratCJH 


> 

return 


10  format (/lx* '***<  ' *4al0*15x* 'histogram®' »rl*5x» 'bktsize8  /»f6*2» 
5x*'no*  of  buckets8  '*i3/6x* 

'movement '3x' interrupt '2x's 1/1 f  dev '2x' operator '3x* 

'cycle  type' lx' weight  cat'lx'ltr  sea'4x'spcl  xpt'3x* 
'cyclestart ' lx ' cycledurat ' /5x  *  NSCWal l//6x * 

'facility  date  shift'/6x*3al0/lx» i4* '  cycles  selected') 


20  format ( lx* i4* 
lx*al0* 
lx*al0* 
lx*al0* 


#  cycle  number 

♦  direction-of-movement 

*  cycle  interruption 

*  s/1  device 
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SUBROUTINE  WRITRPT  ( CYTIH , NOTIMS » TITLE , SELCRI - BRKEYS , HISTSW * 

1  BINSIZ »  NOBIN ) 

PURPOSE-  TO  CALL  STATS  TO  COMPUTE  STATISTICS  ( MEAN « STANDARD 
HE I VAT I ON  ?  AND  OPTIONALLY  A  MEDIAN  AND  HISTOGRAM) 

BASED  ON  A  SET  OF  INPUT  CYCLE  TIMES  AND  t  WHEN  APPROPRIATE 
<I.E.  AT  EACH  FACILITY  BREAK ) r  SHIFT -ACCUMULATED 
STATISTICS.  THEN  TO  PRINT  THESE  OUT  WITH  APPROPRIATE 
HEADINGS.  THIS  ROUTINE  IS  CALLED  EACH  TIME  THERE  IS  A 
BREAK  ON  FACILITY  >  DATE  OR  SHIFT.  AN  ENTRY  POINT  IN  THIS 
ROUTINE  IS  USED  TO  PRINT  SHIFT-ACCUMULATED  STATISTICS 
WHENEVER  FACILITY  CHANGES. 

REAL  SELCRI »  BINSIZ » XBAR »  SDEV»  MEDIAN r BINFREQ* 

1  BINCUM 

INTEGER  NOBIN » SHIFT » NOT I MS » SNOT I MS » TITLE (4 ) t SELCRI (10) >CYTIM  < 200 ) 
DIMENSION  BRKEYS ( 3 >  * BINFRECK  100 >  r 

1  BINREL  <  100 )  »  BINCUM<  100 )  t  SBINREL  ( 100  *  2  )  *  SBINCUM<  100»9)  , 

2  SHMEAN<2>  »SHSDEV(2) >SMEDIAN(2) 

COMMON/SHFSTAT /SHSUM  <  2 ) f  SHSUMSG ( 2 ) » SHBINFR (100x2) t SNOT I MS ( 2 ) 

DATA  BLANK/10H  / 

DATA  SMEDIAN/2*0./ 

DATA  SBINCUM/200#0 . / 

DATA  SBINREL/200*0./ 

SHFSTAT  TRANSPORTS  SHIFT  ACCUMULATED  STATISTICS  NEEDED  WHEN 
ENTRY  POINT  ENTRY  OCCURS. 

DECODE < 10 ' 190 , BRKEYS  <  3 ) )  SHIFT 
190  FORMAT <  ID 
C  WRITE  PAGE  HEADER 

WRITE  <  6  r 100 )  TITLE 
100  FORMAT ( 1H1 »  20X  1 4A10  /  ) 

WRITE < 6 r 1 10 )  BRKEYS(l) fBRKEYS(2>  r SHIFT 

110  F0RMAT(26X» 13HFACILITY  ID-  A4f  2X,  6HDATE-  A3 r 5X » 7HSHIFT-  12 
1  /10X » 19HSELECTI0N  CRITERIA-  ) 

C  PRINT  NGNBl.ANK  VALUED  SELECTION  CRITERION  ONLY 

IF (  SELCRI ( 1 )  .NE.  BLANK  >  WRITE(6rlll>  SELCRI (1> 

111  FORMAT (  38X 1 22HDIRECTI0N  OF  MOVEMENT-  A10  ) 

IF (  SELCRI < 2 )  .NE.  BLANK  )  WRITE<6>112)  SELCRI (2) 

112  FORMAT (  42X  r 18H INTERRUPT ION  CODE-  A10  ) 

IF (  SELCRI (3)  ,NE .  BLANK  >  WRITE(6rll3>  SELCRI (3) 

113  FORMAT <  34X 1 26HSLING/LIFTING  DEVICE  TYPE-  AiO  ) 

IF  (  SELCRI  (4)  .NE.  BLANK  )  WRITE(6rU5>  SELCRI  ( 4  > 

115  FORMAT <  48X * 12H0PERAT0R  ID-  AIO  ) 

IF <  SELCRI (5)  .NE.  BLANK  )  WRITE<6»116>  SELCRI (5) 

116  FORMAT (  49X* 11HCYCLE  TYPE-  AIO  ) 

IF (  SELCRI (6)  .NE,  BLANK  )  WRITE<6>114)  SELCRI (6) 

114  FORMAT  <  44X r 16HWEIGHT  CATEGORY-  AIO  ) 

IF < SELCRI (7)  .NE.  BLANK  )  WRITE<6>120)  SELCRI (7) 

120  FORMAT (  39Xf 21HINTRA/INTER  CARRIER  -  AIO  ) 

IF (  SELCRI <8)  .NE.  BLANK  )  WRITE(6»117>  SELCRI ( 8 > 

117  FORMAT <  35X»25HSPECIAL  TRANSPORTER  CODE-  AIO  ) 

IF <  SELCRI (9)  .NE.  BLANK  )  WRITE<6fll8)  SELCRI <9 ) 
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118  FORMAT<  36X * 24HCYCLE  START  TIME  PERIOD-  AlO  ) 

IF  (  SELCRI  (10)  ♦  NE  ♦  BLANK  )  WRITE<6*119)  SELCRK10) 

119  FORMAT  ( 38X * 22HCYCLE  DURATION  LIMITS-  AlO  ) 

CALL  SUBROUTINE  STATS  TO  COMPUTE  MEAN * MEDIAN * STANDARD  DEVIATION 
AND  HISTOGRAM  VALUES < OPTIONAL )  BASED  ON  A  SET  OF  CYCLE  TIMES 
(CYTIM)  AND  ACCUMULATE  SHIFT  ASSOCIATED  STATISTICS. 

CALL  STATS (  CYTIM * NOTIMS * HISTSW , BINS IZ * NOBIN * XBAR * SDEV * MEDIAN * 

1  BINFREQ  *  BINREL  *  BINCUM  *  SHIFT ) 

C  PRINT  FACILITY/DATE/SHIFT  BREAK  REPORT 

WRITE <  6  * 130 )  NOTIMS *  <CYTIM<I)*I=1 » NOTIMS) 

130  FORMAT <  3X*  I4*18H  CYCLE  TIMES(MIN)-  2X*  101 10/ < 27X *  101 10 >  > 

WRITE <  6  * 140 )  XBAR » SDEV 

140  FORMAT (  10X*  6HMEAN-  F10 . 2 * 10X * 14HSTANDARD  DEV-  F10.2  ) 

IF (HISTSW  .NE.  1RH)  GO  TO  1000 
WRITE (6* 150)  MEDIAN* NOBIN*  BINS I Z 

150  FORMAT <  8X*8HMEDIAN-  F10.1*/  10X * 19HHIST0GRAM  VALUES-  14*  IX* 

1  13HBINS  OF  SIZE  F10.2  /  10X*  3HBIN  7X*  9HFREQUENCY 

2  6X *  13HRELATIVE  FREQ  2X*12HCUM  REL  FREQ  ) 

DO  15  1  =  1  *  NOBIN 

BIN1=(I-1)*BINSIZ 
BIN2=BIN1  +  BINSIZ 

WRITE(6*160)BIN1 » BIN2 * BINFREQ ( I ) *BINREL( I ) *BINCUM( I ) 

160  FORMAT (  2X*  F6.1*  3H  -  F6.1*2X*  F7.1*  6X*  F7.1*  6X*  F7.1  ) 

15  CONTINUE 
1000  CONTINUE 
RETURN 

ENTRY  FACSUM 

IF ( SNOTIMS < 1 )  .EQ.  0  .AND.  SN0TIMS<2>  .EQ.  0)  GO  TO  56 
C  WRITE  PAGE  HEADER 

WRITE < 6 *  100 )  TITLE 
WRITE ( 6 » 200 )  BRKEYS<1) 

200  FORMAT (  10X*32HSHIFT  STATISTICS  FOR  FACILITY  -  A4  /  ) 

C  COMPUTE  SHIFT  STATISTICS 

DO  25  1=1*2 

IF <SNOTIMS< I >  .EQ.  0)  GO  TO  25 
SHMEAN ( I ) =SHSUM < I ) /SNOTIMS ( I ) 

SHSDEV < I ) =SHSUMSQ < I )  /SNOTIMS<I>  - 
1  SHMEAN ( I )  *  SHMEAN(I) 

SHSDEV ( I ) =SQRT ( SHSDEV  < I ) ) 

SMEDIAN< I )=0. 

DO  30  J=1 *NOBIN 

SBINREL< J* I )  =  SHBINFR ( J* I ) /SNOTIMS  < I ) 

30  CONTINUE 

SBINCUM< 1*1)  =  SBINREL< 1*1) 

DO  35  J=2*N0BIN 

SBINCUM<  J* I >  =  SBINCUM( J-l *  I )  +  SBINREL(J*I) 

IF (  SBINCUM( J* I )  .LT.  .5  )  GO  TO  35 

IF <  SMEDIAN(I)  .EQ.  0.  )  SMEDIAN(I)  =  < J-0 . 5 ) *BINSIZ 
35  CONTINUE 

C  PRINT  SHIFT  STATISTICS 


♦  ♦ 


WRITE<6r210>  I,SNOTIMS(I> 

210  FORMAT ( /9X ?  6HSHIFT  II ,  11H  -  BASED  ON  14.  1211  CYCLE  TIMES  /  ) 

WRITE  <6*140) SHMEAN  < I ) » SHSDEU ( I ) 

IF (HISTSW  .NE.  1RH )  GO  TO  48 
WRITE (6r 150 >  SMEDI AN < I > , NOBIN » BINSIZ 
DO  45  J^l t NOBIN 
BIN1=<J-1)*BINSIZ 
BIN2=  BIN1  +  BINSIZ 

WRITE<6,160>  BIN1 »BIN2»SHBINFR( J» I ) »SBINREL< J» I)r 
1  SBINCUM  <  J  r  I  > 

45  CONTINUE 

C  INITIALIZE  SHIFT  ASSOCIATED  PARAMETERS 

48  CONTINUE 

SHSUM(I)  =  0. 

SHSUMSQ(I)  ■  0. 

SNOTIMS  < I >  =  0 
SMEDIAN( I)=0« 

DO  50  J=lr NOBIN 
SHBINFR(Jfl)  =  0. 

SBINCUM<  Jr  I  )=>0  ♦ 

SBINREL ( J  r I ) =0 ♦ 

50  CONTINUE 
25  CONTINUE 
56  CONTINUE 
RETURN 
END 
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SUBROUTINE  STATS  (CYTIM?NOTIMS?HISTSW? BINSIZ ? NOB IN • XBAR • SDEV ? 

1  MEDIAN?  BINFREQ  ?  BINREL  ?  BINCUM  ?  SHIFT ) 

PURPOSE-  TO  COMPUTE  A  MEAN ? STANDARD  DEVIATION “MEDIAN  AND 

(OPTIONALLY)  HISTOGRAM  VALUES  BASED  ON  A  SET  OF  INPUT 
CYCLE  TIMES.  IN  ADDITION?  TO  ACCUMULATE  SHIFT  ASSOCIATED 
STATISTICS. 

DIMENSION  BINFREG ( 100 ) ? BINREL ( 100 ) ? BINCUM ( 100 ) 

INTEGER  CYTIM(200) 

INTEGER  SHIFT? SNOTIMS 
REAL  MEDIAN 

COMMON/SHFSTAT /SHSUM  <  2 ) ?  SHSUMSQ ( 2) ?  SHBINFR  < 100  ?  2 ) ?  SNOTIMS  <  2 ) 
INITIALIZE  SHIFT  ASSOCIATED  PARAMETERS 
DATA  SHSUM? SHSUMSQ? SNOT IMS/  2*0 . ? 2*0 . ? 2*0/ ? 

1  SHBINFR/200*0 . / 

INITIALIZE  NON  SHIFT  ASSOCIATED  STATISTICS 
XBAR*0. 

SDEV=0. 

MEDIAN=0. 

DO  5  J=l?100 
BINFREQ( J>*0. 

BINREL(J>=0. 

BINCUM  <  J) =0 . 

5  CONTINUE 
SUM=0. 

SUMSG=0. 

MEAN  AND  STANDARD  DEVIATION 
DO  10  1*1 ?NOTIMS 
CYC=CYTIM< I ) 

SUM*  SUM  +  CYC 
SUMSG*  SUMSG  +  CYC*CYC 
10  CONTINUE 

XBAR*  SUM/NOTIMS 

SDEV*  SUMSQ/NOTIMS  -  XBAR*XBAR 

SDEV*SQRT ( SDEV ) 

HISTOGRAM  VALUES  (IF  HISTSW  *  TRUE) 

(NOTE-ENDPOINTS  OF  FIRST  BIN  -  0  TO  1*BINSIZ 

ENDPOINTS  OF  JTH  BIN  -( J-l )*BINSIZ  TO  J*BINSIZ 
ENDPOINTS  OF  LAST  BIN  -(NOBIN-1 )*BINSIZ  TO  NOBIN*BINSIZ ) 

BIN  FREQUENCY 
DO  15  1*1 rNOTIMS 
CYC*CYTIM( I ) 

DO  20  J*1 ? NOBIN 

K*NOBIN  -  J 

IF(CYC  .LE.  K*BINSIZ)  GO  TO  20 
BINFREQ<K+1 )=BINFREG(K+1 )  +  1 
GO  TO  15 
20  CONTINUE 
15  CONTINUE 

RELATIVE  BIN  FREQUENCY 
DO  25  J*1 ? NOBIN 


non 


BINREL  <  J ) =BINFREQ<  J) /NOT I MS 
25  CONTINUE 

C  MEDIAN  AND  CUMULATIVE  RELATIVE  FREQUENCY 

BINCUM  <  1 ) “BINREL  < 1 ) 

DO  30  J=2f NOBIN 

BINCUM  <  J  >  =  BINCUM  <  J-l >  +  BINREL(J) 

FIND  MAXIMUM  BINCUM  (ASSUMED  NOT  TO  BE  THE  FIRST)  WITH  VALUE  LESS 
THAN  .5  AND  USE  MIDPOINT  AS  APPROXIMATE  MEDIAN 
<  <J-2)*INTSIZ  +  .5*INTSIZ  > 

IF  (  BINCUM(J)  .LT.  .5  )  GO  TO  30 

IF<  MEDIAN  .  ECJ.  0.)  MEDIAN  =  ( J-0 * 5 ) *BINSIZ 
30  CONTINUE 

C  ACCUMULATE  SHIFT  ASSOCIATED  STATISTICS 

SHSUM( SHIFT >=  SHSUM(SHIFT)  +  SUM 
SHSUMSGK  SHIFT >  =  SHSUMSQ ( SHIFT)  +  SUMSQ 
SNOT I MS ( SHIFT ) *  SNOTIMS < SHIFT )  +  NOTIMS 
DO  35  J*1 » NOBIN 

SHBINFR< J»SHIFT)=  SHBINFR  <  J» SHIFT )  +  BINFREQ(J) 

35  CONTINUE 
RETURN 
END 
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10/16/78 


11.52*53 


ENDFILE 


PAGE  NO 


123456789 

logical  function  endfile  (nunit) 
if (eof (nunit )  0)  < 

endfile  =  .true, 
return 

> 

endfile  =  .false. 
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